Actual source code: index.c
petsc-3.13.0 2020-03-29
1: /*
2: Defines the abstract operations on index sets, i.e. the public interface.
3: */
4: #include <petsc/private/isimpl.h>
5: #include <petscviewer.h>
6: #include <petscsf.h>
8: /* Logging support */
9: PetscClassId IS_CLASSID;
10: /* TODO: Much more events are missing! */
11: PetscLogEvent IS_View;
12: PetscLogEvent IS_Load;
14: /*@
15: ISRenumber - Renumbers an index set (with multiplicities) in a contiguous way.
17: Collective on IS
19: Input Parmeters:
20: + subset - the index set
21: - subset_mult - the multiplcity of each entry in subset (optional, can be NULL)
23: Output Parameters:
24: + N - the maximum entry of the new IS
25: - subset_n - the new IS
27: Level: intermediate
29: .seealso:
30: @*/
31: PetscErrorCode ISRenumber(IS subset, IS subset_mult, PetscInt *N, IS *subset_n)
32: {
33: PetscSF sf;
34: PetscLayout map;
35: const PetscInt *idxs;
36: PetscInt *leaf_data,*root_data,*gidxs;
37: PetscInt N_n,n,i,lbounds[2],gbounds[2],Nl;
38: PetscInt n_n,nlocals,start,first_index;
39: PetscMPIInt commsize;
40: PetscBool first_found;
45: if (subset_mult) {
47: }
48: if (!N && !subset_n) return(0);
49: ISGetLocalSize(subset,&n);
50: if (subset_mult) {
51: ISGetLocalSize(subset_mult,&i);
52: if (i != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Local subset and multiplicity sizes don't match! %d != %d",n,i);
53: }
54: /* create workspace layout for computing global indices of subset */
55: ISGetIndices(subset,&idxs);
56: lbounds[0] = lbounds[1] = 0;
57: for (i=0;i<n;i++) {
58: if (idxs[i] < lbounds[0]) lbounds[0] = idxs[i];
59: else if (idxs[i] > lbounds[1]) lbounds[1] = idxs[i];
60: }
61: lbounds[0] = -lbounds[0];
62: MPIU_Allreduce(lbounds,gbounds,2,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)subset));
63: gbounds[0] = -gbounds[0];
64: N_n = gbounds[1] - gbounds[0] + 1;
66: PetscLayoutCreate(PetscObjectComm((PetscObject)subset),&map);
67: PetscLayoutSetBlockSize(map,1);
68: PetscLayoutSetSize(map,N_n);
69: PetscLayoutSetUp(map);
70: PetscLayoutGetLocalSize(map,&Nl);
72: /* create sf : leaf_data == multiplicity of indexes, root data == global index in layout */
73: PetscMalloc2(n,&leaf_data,Nl,&root_data);
74: if (subset_mult) {
75: const PetscInt* idxs_mult;
77: ISGetIndices(subset_mult,&idxs_mult);
78: PetscArraycpy(leaf_data,idxs_mult,n);
79: ISRestoreIndices(subset_mult,&idxs_mult);
80: } else {
81: for (i=0;i<n;i++) leaf_data[i] = 1;
82: }
83: /* local size of new subset */
84: n_n = 0;
85: for (i=0;i<n;i++) n_n += leaf_data[i];
87: /* global indexes in layout */
88: PetscMalloc1(n_n,&gidxs); /* allocating possibly extra space in gidxs which will be used later */
89: for (i=0;i<n;i++) gidxs[i] = idxs[i] - gbounds[0];
90: ISRestoreIndices(subset,&idxs);
91: PetscSFCreate(PetscObjectComm((PetscObject)subset),&sf);
92: PetscSFSetGraphLayout(sf,map,n,NULL,PETSC_COPY_VALUES,gidxs);
93: PetscLayoutDestroy(&map);
95: /* reduce from leaves to roots */
96: PetscArrayzero(root_data,Nl);
97: PetscSFReduceBegin(sf,MPIU_INT,leaf_data,root_data,MPI_MAX);
98: PetscSFReduceEnd(sf,MPIU_INT,leaf_data,root_data,MPI_MAX);
100: /* count indexes in local part of layout */
101: nlocals = 0;
102: first_index = -1;
103: first_found = PETSC_FALSE;
104: for (i=0;i<Nl;i++) {
105: if (!first_found && root_data[i]) {
106: first_found = PETSC_TRUE;
107: first_index = i;
108: }
109: nlocals += root_data[i];
110: }
112: /* cumulative of number of indexes and size of subset without holes */
113: #if defined(PETSC_HAVE_MPI_EXSCAN)
114: start = 0;
115: MPI_Exscan(&nlocals,&start,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)subset));
116: #else
117: MPI_Scan(&nlocals,&start,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)subset));
118: start = start-nlocals;
119: #endif
121: if (N) { /* compute total size of new subset if requested */
122: *N = start + nlocals;
123: MPI_Comm_size(PetscObjectComm((PetscObject)subset),&commsize);
124: MPI_Bcast(N,1,MPIU_INT,commsize-1,PetscObjectComm((PetscObject)subset));
125: }
127: if (!subset_n) {
128: PetscFree(gidxs);
129: PetscSFDestroy(&sf);
130: PetscFree2(leaf_data,root_data);
131: return(0);
132: }
134: /* adapt root data with cumulative */
135: if (first_found) {
136: PetscInt old_index;
138: root_data[first_index] += start;
139: old_index = first_index;
140: for (i=first_index+1;i<Nl;i++) {
141: if (root_data[i]) {
142: root_data[i] += root_data[old_index];
143: old_index = i;
144: }
145: }
146: }
148: /* from roots to leaves */
149: PetscSFBcastBegin(sf,MPIU_INT,root_data,leaf_data);
150: PetscSFBcastEnd(sf,MPIU_INT,root_data,leaf_data);
151: PetscSFDestroy(&sf);
153: /* create new IS with global indexes without holes */
154: if (subset_mult) {
155: const PetscInt* idxs_mult;
156: PetscInt cum;
158: cum = 0;
159: ISGetIndices(subset_mult,&idxs_mult);
160: for (i=0;i<n;i++) {
161: PetscInt j;
162: for (j=0;j<idxs_mult[i];j++) gidxs[cum++] = leaf_data[i] - idxs_mult[i] + j;
163: }
164: ISRestoreIndices(subset_mult,&idxs_mult);
165: } else {
166: for (i=0;i<n;i++) {
167: gidxs[i] = leaf_data[i]-1;
168: }
169: }
170: ISCreateGeneral(PetscObjectComm((PetscObject)subset),n_n,gidxs,PETSC_OWN_POINTER,subset_n);
171: PetscFree2(leaf_data,root_data);
172: return(0);
173: }
176: /*@
177: ISCreateSubIS - Create a sub index set from a global index set selecting some components.
179: Collective on IS
181: Input Parmeters:
182: + is - the index set
183: - comps - which components we will extract from is
185: Output Parameters:
186: . subis - the new sub index set
188: Level: intermediate
190: Example usage:
191: We have an index set (is) living on 3 processes with the following values:
192: | 4 9 0 | 2 6 7 | 10 11 1|
193: and another index set (comps) used to indicate which components of is we want to take,
194: | 7 5 | 1 2 | 0 4|
195: The output index set (subis) should look like:
196: | 11 7 | 9 0 | 4 6|
198: .seealso: VecGetSubVector(), MatCreateSubMatrix()
199: @*/
200: PetscErrorCode ISCreateSubIS(IS is,IS comps,IS *subis)
201: {
202: PetscSF sf;
203: const PetscInt *is_indices,*comps_indices;
204: PetscInt *subis_indices,nroots,nleaves,*mine,i,lidx;
205: PetscMPIInt owner;
206: PetscSFNode *remote;
207: PetscErrorCode ierr;
208: MPI_Comm comm;
215: PetscObjectGetComm((PetscObject)is, &comm);
216: ISGetLocalSize(comps,&nleaves);
217: ISGetLocalSize(is,&nroots);
218: PetscMalloc1(nleaves,&remote);
219: PetscMalloc1(nleaves,&mine);
220: ISGetIndices(comps,&comps_indices);
221: /*
222: * Construct a PetscSF in which "is" data serves as roots and "subis" is leaves.
223: * Root data are sent to leaves using PetscSFBcast().
224: * */
225: for (i=0; i<nleaves; i++) {
226: mine[i] = i;
227: /* Connect a remote root with the current leaf. The value on the remote root
228: * will be received by the current local leaf.
229: * */
230: owner = -1;
231: lidx = -1;
232: PetscLayoutFindOwnerIndex(is->map,comps_indices[i],&owner,&lidx);
233: remote[i].rank = owner;
234: remote[i].index = lidx;
235: }
236: ISRestoreIndices(comps,&comps_indices);
237: PetscSFCreate(comm,&sf);
238: PetscSFSetFromOptions(sf);\
239: PetscSFSetGraph(sf,nroots,nleaves,mine,PETSC_OWN_POINTER,remote,PETSC_OWN_POINTER);
241: PetscMalloc1(nleaves,&subis_indices);
242: ISGetIndices(is, &is_indices);
243: PetscSFBcastBegin(sf,MPIU_INT,is_indices,subis_indices);
244: PetscSFBcastEnd(sf,MPIU_INT,is_indices,subis_indices);
245: ISRestoreIndices(is,&is_indices);
246: PetscSFDestroy(&sf);
247: ISCreateGeneral(comm,nleaves,subis_indices,PETSC_OWN_POINTER,subis);
248: return(0);
249: }
251: /*@
252: ISClearInfoCache - clear the cache of computed index set properties
254: Not collective
256: Input Parameters:
257: + is - the index set
258: - clear_permanent_local - whether to remove the permanent status of local properties
260: NOTE: because all processes must agree on the global permanent status of a property,
261: the permanent status can only be changed with ISSetInfo(), because this routine is not collective
263: Level: developer
265: .seealso: ISInfo, ISInfoType, ISSetInfo(), ISClearInfoCache()
267: @*/
268: PetscErrorCode ISClearInfoCache(IS is, PetscBool clear_permanent_local)
269: {
270: PetscInt i, j;
275: for (i = 0; i < IS_INFO_MAX; i++) {
276: if (clear_permanent_local) is->info_permanent[IS_LOCAL][i] = PETSC_FALSE;
277: for (j = 0; j < 2; j++) {
278: if (!is->info_permanent[j][i]) is->info[j][i] = IS_INFO_UNKNOWN;
279: }
280: }
281: return(0);
282: }
284: static PetscErrorCode ISSetInfo_Internal(IS is, ISInfo info, ISInfoType type, ISInfoBool ipermanent, PetscBool flg)
285: {
286: ISInfoBool iflg = flg ? IS_INFO_TRUE : IS_INFO_FALSE;
287: PetscInt itype = (type == IS_LOCAL) ? 0 : 1;
288: PetscBool permanent_set = (ipermanent == IS_INFO_UNKNOWN) ? PETSC_FALSE : PETSC_TRUE;
289: PetscBool permanent = (ipermanent == IS_INFO_TRUE) ? PETSC_TRUE : PETSC_FALSE;
292: /* set this property */
293: is->info[itype][(int)info] = iflg;
294: if (permanent_set) is->info_permanent[itype][(int)info] = permanent;
295: /* set implications */
296: switch (info) {
297: case IS_SORTED:
298: if (flg && type == IS_GLOBAL) { /* an array that is globally sorted is also locally sorted */
299: is->info[IS_LOCAL][(int)info] = IS_INFO_TRUE;
300: /* global permanence implies local permanence */
301: if (permanent_set && permanent) is->info_permanent[IS_LOCAL][(int)info] = PETSC_TRUE;
302: }
303: if (!flg) { /* if an array is not sorted, it cannot be an interval or the identity */
304: is->info[itype][IS_INTERVAL] = IS_INFO_FALSE;
305: is->info[itype][IS_IDENTITY] = IS_INFO_FALSE;
306: if (permanent_set) {
307: is->info_permanent[itype][IS_INTERVAL] = permanent;
308: is->info_permanent[itype][IS_IDENTITY] = permanent;
309: }
310: }
311: break;
312: case IS_UNIQUE:
313: if (flg && type == IS_GLOBAL) { /* an array that is globally unique is also locally unique */
314: is->info[IS_LOCAL][(int)info] = IS_INFO_TRUE;
315: /* global permanence implies local permanence */
316: if (permanent_set && permanent) is->info_permanent[IS_LOCAL][(int)info] = PETSC_TRUE;
317: }
318: if (!flg) { /* if an array is not unique, it cannot be a permutation, and interval, or the identity */
319: is->info[itype][IS_PERMUTATION] = IS_INFO_FALSE;
320: is->info[itype][IS_INTERVAL] = IS_INFO_FALSE;
321: is->info[itype][IS_IDENTITY] = IS_INFO_FALSE;
322: if (permanent_set) {
323: is->info_permanent[itype][IS_PERMUTATION] = permanent;
324: is->info_permanent[itype][IS_INTERVAL] = permanent;
325: is->info_permanent[itype][IS_IDENTITY] = permanent;
326: }
327: }
328: break;
329: case IS_PERMUTATION:
330: if (flg) { /* an array that is a permutation is unique and is unique locally */
331: is->info[itype][IS_UNIQUE] = IS_INFO_TRUE;
332: is->info[IS_LOCAL][IS_UNIQUE] = IS_INFO_TRUE;
333: if (permanent_set && permanent) {
334: is->info_permanent[itype][IS_UNIQUE] = PETSC_TRUE;
335: is->info_permanent[IS_LOCAL][IS_UNIQUE] = PETSC_TRUE;
336: }
337: } else { /* an array that is not a permutation cannot be the identity */
338: is->info[itype][IS_IDENTITY] = IS_INFO_FALSE;
339: if (permanent_set) is->info_permanent[itype][IS_IDENTITY] = permanent;
340: }
341: break;
342: case IS_INTERVAL:
343: if (flg) { /* an array that is an interval is sorted and unique */
344: is->info[itype][IS_SORTED] = IS_INFO_TRUE;
345: is->info[IS_LOCAL][IS_SORTED] = IS_INFO_TRUE;
346: is->info[itype][IS_UNIQUE] = IS_INFO_TRUE;
347: is->info[IS_LOCAL][IS_UNIQUE] = IS_INFO_TRUE;
348: if (permanent_set && permanent) {
349: is->info_permanent[itype][IS_SORTED] = PETSC_TRUE;
350: is->info_permanent[IS_LOCAL][IS_SORTED] = PETSC_TRUE;
351: is->info_permanent[itype][IS_UNIQUE] = PETSC_TRUE;
352: is->info_permanent[IS_LOCAL][IS_UNIQUE] = PETSC_TRUE;
353: }
354: } else { /* an array that is not an interval cannot be the identity */
355: is->info[itype][IS_IDENTITY] = IS_INFO_FALSE;
356: if (permanent_set) is->info_permanent[itype][IS_IDENTITY] = permanent;
357: }
358: break;
359: case IS_IDENTITY:
360: if (flg) { /* an array that is the identity is sorted, unique, an interval, and a permutation */
361: is->info[itype][IS_SORTED] = IS_INFO_TRUE;
362: is->info[IS_LOCAL][IS_SORTED] = IS_INFO_TRUE;
363: is->info[itype][IS_UNIQUE] = IS_INFO_TRUE;
364: is->info[IS_LOCAL][IS_UNIQUE] = IS_INFO_TRUE;
365: is->info[itype][IS_PERMUTATION] = IS_INFO_TRUE;
366: is->info[itype][IS_INTERVAL] = IS_INFO_TRUE;
367: is->info[IS_LOCAL][IS_INTERVAL] = IS_INFO_TRUE;
368: if (permanent_set && permanent) {
369: is->info_permanent[itype][IS_SORTED] = PETSC_TRUE;
370: is->info_permanent[IS_LOCAL][IS_SORTED] = PETSC_TRUE;
371: is->info_permanent[itype][IS_UNIQUE] = PETSC_TRUE;
372: is->info_permanent[IS_LOCAL][IS_UNIQUE] = PETSC_TRUE;
373: is->info_permanent[itype][IS_PERMUTATION] = PETSC_TRUE;
374: is->info_permanent[itype][IS_INTERVAL] = PETSC_TRUE;
375: is->info_permanent[IS_LOCAL][IS_INTERVAL] = PETSC_TRUE;
376: }
377: }
378: break;
379: default:
380: if (type == IS_LOCAL) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown IS property");
381: else SETERRQ(PetscObjectComm((PetscObject)is), PETSC_ERR_ARG_OUTOFRANGE, "Unknown IS property");
382: }
383: return(0);
384: }
386: /*@
387: ISSetInfo - Set known information about an index set.
389: Logically Collective on IS if type is IS_GLOBAL
391: Input Parameters:
392: + is - the index set
393: . info - describing a property of the index set, one of those listed below,
394: . type - IS_LOCAL if the information describes the local portion of the index set,
395: IS_GLOBAL if it describes the whole index set
396: . permanent - PETSC_TRUE if it is known that the property will persist through changes to the index set, PETSC_FALSE otherwise
397: If the user sets a property as permanently known, it will bypass computation of that property
398: - flg - set the described property as true (PETSC_TRUE) or false (PETSC_FALSE)
400: Info Describing IS Structure:
401: + IS_SORTED - the [local part of the] index set is sorted in ascending order
402: . IS_UNIQUE - each entry in the [local part of the] index set is unique
403: . IS_PERMUTATION - the [local part of the] index set is a permutation of the integers {0, 1, ..., N-1}, where N is the size of the [local part of the] index set
404: . IS_INTERVAL - the [local part of the] index set is equal to a contiguous range of integers {f, f + 1, ..., f + N-1}
405: - IS_IDENTITY - the [local part of the] index set is equal to the integers {0, 1, ..., N-1}
408: Notes:
409: If type is IS_GLOBAL, all processes that share the index set must pass the same value in flg
411: It is possible to set a property with ISSetInfo() that contradicts what would be previously computed with ISGetInfo()
413: Level: advanced
415: .seealso: ISInfo, ISInfoType, IS
417: @*/
418: PetscErrorCode ISSetInfo(IS is, ISInfo info, ISInfoType type, PetscBool permanent, PetscBool flg)
419: {
420: MPI_Comm comm, errcomm;
421: PetscMPIInt size;
427: comm = PetscObjectComm((PetscObject)is);
428: if (type == IS_GLOBAL) {
432: errcomm = comm;
433: } else {
434: errcomm = PETSC_COMM_SELF;
435: }
437: if (((int) info) <= IS_INFO_MIN || ((int) info) >= IS_INFO_MAX) SETERRQ1(errcomm,PETSC_ERR_ARG_OUTOFRANGE,"Options %d is out of range",(int)info);
439: MPI_Comm_size(comm, &size);
440: /* do not use global values if size == 1: it makes it easier to keep the implications straight */
441: if (size == 1) type = IS_LOCAL;
442: ISSetInfo_Internal(is, info, type, permanent ? IS_INFO_TRUE : IS_INFO_FALSE, flg);
443: return(0);
444: }
446: static PetscErrorCode ISGetInfo_Sorted(IS is, ISInfoType type, PetscBool *flg)
447: {
448: MPI_Comm comm;
449: PetscMPIInt size, rank;
453: comm = PetscObjectComm((PetscObject)is);
454: MPI_Comm_size(comm, &size);
455: MPI_Comm_size(comm, &rank);
456: if (type == IS_GLOBAL && is->ops->sortedglobal) {
457: (*is->ops->sortedglobal)(is,flg);
458: } else {
459: PetscBool sortedLocal = PETSC_FALSE;
461: /* determine if the array is locally sorted */
462: if (type == IS_GLOBAL && size > 1) {
463: /* call ISGetInfo so that a cached value will be used if possible */
464: ISGetInfo(is, IS_SORTED, IS_LOCAL, PETSC_TRUE, &sortedLocal);
465: } else if (is->ops->sortedlocal) {
466: (*is->ops->sortedlocal)(is,&sortedLocal);
467: } else {
468: /* default: get the local indices and directly check */
469: const PetscInt *idx;
470: PetscInt n;
472: ISGetIndices(is, &idx);
473: ISGetLocalSize(is, &n);
474: PetscSortedInt(n, idx, &sortedLocal);
475: ISRestoreIndices(is, &idx);
476: }
478: if (type == IS_LOCAL || size == 1) {
479: *flg = sortedLocal;
480: } else {
481: MPI_Allreduce(&sortedLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
482: if (*flg) {
483: PetscInt n, min = PETSC_MAX_INT, max = PETSC_MIN_INT;
484: PetscInt maxprev;
486: ISGetLocalSize(is, &n);
487: if (n) {ISGetMinMax(is, &min, &max);}
488: maxprev = PETSC_MIN_INT;
489: MPI_Exscan(&max, &maxprev, 1, MPIU_INT, MPI_MAX, comm);
490: if (rank && (maxprev > min)) sortedLocal = PETSC_FALSE;
491: MPI_Allreduce(&sortedLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
492: }
493: }
494: }
495: return(0);
496: }
498: PetscErrorCode ISGetIndicesCopy(IS is, PetscInt idx[]);
500: static PetscErrorCode ISGetInfo_Unique(IS is, ISInfoType type, PetscBool *flg)
501: {
502: MPI_Comm comm;
503: PetscMPIInt size, rank;
504: PetscInt i;
508: comm = PetscObjectComm((PetscObject)is);
509: MPI_Comm_size(comm, &size);
510: MPI_Comm_size(comm, &rank);
511: if (type == IS_GLOBAL && is->ops->uniqueglobal) {
512: (*is->ops->uniqueglobal)(is,flg);
513: } else {
514: PetscBool uniqueLocal;
515: PetscInt n = -1;
516: PetscInt *idx = NULL;
518: /* determine if the array is locally unique */
519: if (type == IS_GLOBAL && size > 1) {
520: /* call ISGetInfo so that a cached value will be used if possible */
521: ISGetInfo(is, IS_UNIQUE, IS_LOCAL, PETSC_TRUE, &uniqueLocal);
522: } else if (is->ops->uniquelocal) {
523: (*is->ops->uniquelocal)(is,&uniqueLocal);
524: } else {
525: /* default: get the local indices and directly check */
526: uniqueLocal = PETSC_TRUE;
527: ISGetLocalSize(is, &n);
528: PetscMalloc1(n, &idx);
529: ISGetIndicesCopy(is, idx);
530: PetscSortInt(n, idx);
531: for (i = 1; i < n; i++) if (idx[i] == idx[i-1]) break;
532: if (i < n) uniqueLocal = PETSC_FALSE;
533: }
535: PetscFree(idx);
536: if (type == IS_LOCAL || size == 1) {
537: *flg = uniqueLocal;
538: } else {
539: MPI_Allreduce(&uniqueLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
540: if (*flg) {
541: PetscInt min = PETSC_MAX_INT, max = PETSC_MIN_INT, maxprev;
543: if (!idx) {
544: ISGetLocalSize(is, &n);
545: PetscMalloc1(n, &idx);
546: ISGetIndicesCopy(is, idx);
547: }
548: PetscParallelSortInt(is->map, is->map, idx, idx);
549: if (n) {
550: min = idx[0];
551: max = idx[n - 1];
552: }
553: for (i = 1; i < n; i++) if (idx[i] == idx[i-1]) break;
554: if (i < n) uniqueLocal = PETSC_FALSE;
555: maxprev = PETSC_MIN_INT;
556: MPI_Exscan(&max, &maxprev, 1, MPIU_INT, MPI_MAX, comm);
557: if (rank && (maxprev == min)) uniqueLocal = PETSC_FALSE;
558: MPI_Allreduce(&uniqueLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
559: }
560: }
561: PetscFree(idx);
562: }
563: return(0);
564: }
566: static PetscErrorCode ISGetInfo_Permutation(IS is, ISInfoType type, PetscBool *flg)
567: {
568: MPI_Comm comm;
569: PetscMPIInt size, rank;
573: comm = PetscObjectComm((PetscObject)is);
574: MPI_Comm_size(comm, &size);
575: MPI_Comm_size(comm, &rank);
576: if (type == IS_GLOBAL && is->ops->permglobal) {
577: (*is->ops->permglobal)(is,flg);
578: } else if (type == IS_LOCAL && is->ops->permlocal) {
579: (*is->ops->permlocal)(is,flg);
580: } else {
581: PetscBool permLocal;
582: PetscInt n, i, rStart;
583: PetscInt *idx;
585: ISGetLocalSize(is, &n);
586: PetscMalloc1(n, &idx);
587: ISGetIndicesCopy(is, idx);
588: if (type == IS_GLOBAL) {
589: PetscParallelSortInt(is->map, is->map, idx, idx);
590: PetscLayoutGetRange(is->map, &rStart, NULL);
591: } else {
592: PetscSortInt(n, idx);
593: rStart = 0;
594: }
595: permLocal = PETSC_TRUE;
596: for (i = 0; i < n; i++) {
597: if (idx[i] != rStart + i) break;
598: }
599: if (i < n) permLocal = PETSC_FALSE;
600: if (type == IS_LOCAL || size == 1) {
601: *flg = permLocal;
602: } else {
603: MPI_Allreduce(&permLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
604: }
605: PetscFree(idx);
606: }
607: return(0);
608: }
610: static PetscErrorCode ISGetInfo_Interval(IS is, ISInfoType type, PetscBool *flg)
611: {
612: MPI_Comm comm;
613: PetscMPIInt size, rank;
614: PetscInt i;
618: comm = PetscObjectComm((PetscObject)is);
619: MPI_Comm_size(comm, &size);
620: MPI_Comm_size(comm, &rank);
621: if (type == IS_GLOBAL && is->ops->intervalglobal) {
622: (*is->ops->intervalglobal)(is,flg);
623: } else {
624: PetscBool intervalLocal;
626: /* determine if the array is locally an interval */
627: if (type == IS_GLOBAL && size > 1) {
628: /* call ISGetInfo so that a cached value will be used if possible */
629: ISGetInfo(is, IS_INTERVAL, IS_LOCAL, PETSC_TRUE, &intervalLocal);
630: } else if (is->ops->intervallocal) {
631: (*is->ops->intervallocal)(is,&intervalLocal);
632: } else {
633: PetscInt n;
634: const PetscInt *idx;
635: /* default: get the local indices and directly check */
636: intervalLocal = PETSC_TRUE;
637: ISGetLocalSize(is, &n);
638: PetscMalloc1(n, &idx);
639: ISGetIndices(is, &idx);
640: for (i = 1; i < n; i++) if (idx[i] != idx[i-1] + 1) break;
641: if (i < n) intervalLocal = PETSC_FALSE;
642: ISRestoreIndices(is, &idx);
643: }
645: if (type == IS_LOCAL || size == 1) {
646: *flg = intervalLocal;
647: } else {
648: MPI_Allreduce(&intervalLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
649: if (*flg) {
650: PetscInt n, min = PETSC_MAX_INT, max = PETSC_MIN_INT;
651: PetscInt maxprev;
653: ISGetLocalSize(is, &n);
654: if (n) {ISGetMinMax(is, &min, &max);}
655: maxprev = PETSC_MIN_INT;
656: MPI_Exscan(&max, &maxprev, 1, MPIU_INT, MPI_MAX, comm);
657: if (rank && n && (maxprev != min - 1)) intervalLocal = PETSC_FALSE;
658: MPI_Allreduce(&intervalLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
659: }
660: }
661: }
662: return(0);
663: }
665: static PetscErrorCode ISGetInfo_Identity(IS is, ISInfoType type, PetscBool *flg)
666: {
667: MPI_Comm comm;
668: PetscMPIInt size, rank;
672: comm = PetscObjectComm((PetscObject)is);
673: MPI_Comm_size(comm, &size);
674: MPI_Comm_size(comm, &rank);
675: if (type == IS_GLOBAL && is->ops->intervalglobal) {
676: PetscBool isinterval;
678: (*is->ops->intervalglobal)(is,&isinterval);
679: *flg = PETSC_FALSE;
680: if (isinterval) {
681: PetscInt min;
683: ISGetMinMax(is, &min, NULL);
684: MPI_Bcast(&min, 1, MPIU_INT, 0, comm);
685: if (min == 0) *flg = PETSC_TRUE;
686: }
687: } else if (type == IS_LOCAL && is->ops->intervallocal) {
688: PetscBool isinterval;
690: (*is->ops->intervallocal)(is,&isinterval);
691: *flg = PETSC_FALSE;
692: if (isinterval) {
693: PetscInt min;
695: ISGetMinMax(is, &min, NULL);
696: if (min == 0) *flg = PETSC_TRUE;
697: }
698: } else {
699: PetscBool identLocal;
700: PetscInt n, i, rStart;
701: const PetscInt *idx;
703: ISGetLocalSize(is, &n);
704: ISGetIndices(is, &idx);
705: PetscLayoutGetRange(is->map, &rStart, NULL);
706: identLocal = PETSC_TRUE;
707: for (i = 0; i < n; i++) {
708: if (idx[i] != rStart + i) break;
709: }
710: if (i < n) identLocal = PETSC_FALSE;
711: if (type == IS_LOCAL || size == 1) {
712: *flg = identLocal;
713: } else {
714: MPI_Allreduce(&identLocal, flg, 1, MPIU_BOOL, MPI_LAND, comm);
715: }
716: ISRestoreIndices(is, &idx);
717: }
718: return(0);
719: }
721: /*@
722: ISGetInfo - Determine whether an index set satisfies a given property
724: Collective or logically collective on IS if the type is IS_GLOBAL (logically collective if the value of the property has been permanently set with ISSetInfo())
726: Input Parameters:
727: + is - the index set
728: . info - describing a property of the index set, one of those listed in the documentation of ISSetInfo()
729: . compute - if PETSC_FALSE, the property will not be computed if it is not already known and the property will be assumed to be false
730: - type - whether the property is local (IS_LOCAL) or global (IS_GLOBAL)
732: Output Parameter:
733: . flg - wheter the property is true (PETSC_TRUE) or false (PETSC_FALSE)
735: Note: ISGetInfo uses cached values when possible, which will be incorrect if ISSetInfo() has been called with incorrect information. To clear cached values, use ISClearInfoCache().
737: Level: advanced
739: .seealso: ISInfo, ISInfoType, ISSetInfo(), ISClearInfoCache()
741: @*/
742: PetscErrorCode ISGetInfo(IS is, ISInfo info, ISInfoType type, PetscBool compute, PetscBool *flg)
743: {
744: MPI_Comm comm, errcomm;
745: PetscMPIInt rank, size;
746: PetscInt itype;
747: PetscBool hasprop;
748: PetscBool infer;
754: comm = PetscObjectComm((PetscObject)is);
755: if (type == IS_GLOBAL) {
757: errcomm = comm;
758: } else {
759: errcomm = PETSC_COMM_SELF;
760: }
762: MPI_Comm_size(comm, &size);
763: MPI_Comm_rank(comm, &rank);
765: if (((int) info) <= IS_INFO_MIN || ((int) info) >= IS_INFO_MAX) SETERRQ1(errcomm,PETSC_ERR_ARG_OUTOFRANGE,"Options %d is out of range",(int)info);
766: if (size == 1) type = IS_LOCAL;
767: itype = (type == IS_LOCAL) ? 0 : 1;
768: hasprop = PETSC_FALSE;
769: infer = PETSC_FALSE;
770: if (is->info_permanent[itype][(int)info]) {
771: hasprop = (is->info[itype][(int)info] == IS_INFO_TRUE) ? PETSC_TRUE : PETSC_FALSE;
772: infer = PETSC_TRUE;
773: } else if ((itype == IS_LOCAL) && (is->info[IS_LOCAL][info] != IS_INFO_UNKNOWN)) {
774: /* we can cache local properties as long as we clear them when the IS changes */
775: /* NOTE: we only cache local values because there is no ISAssemblyBegin()/ISAssemblyEnd(),
776: so we have no way of knowing when a cached value has been invalidated by changes on a different process */
777: hasprop = (is->info[itype][(int)info] == IS_INFO_TRUE) ? PETSC_TRUE : PETSC_FALSE;
778: infer = PETSC_TRUE;
779: } else if (compute) {
780: switch (info) {
781: case IS_SORTED:
782: ISGetInfo_Sorted(is, type, &hasprop);
783: break;
784: case IS_UNIQUE:
785: ISGetInfo_Unique(is, type, &hasprop);
786: break;
787: case IS_PERMUTATION:
788: ISGetInfo_Permutation(is, type, &hasprop);
789: break;
790: case IS_INTERVAL:
791: ISGetInfo_Interval(is, type, &hasprop);
792: break;
793: case IS_IDENTITY:
794: ISGetInfo_Identity(is, type, &hasprop);
795: break;
796: default:
797: SETERRQ(errcomm, PETSC_ERR_ARG_OUTOFRANGE, "Unknown IS property");
798: }
799: infer = PETSC_TRUE;
800: }
801: /* call ISSetInfo_Internal to keep all of the implications straight */
802: if (infer) {ISSetInfo_Internal(is, info, type, IS_INFO_UNKNOWN, hasprop);}
803: *flg = hasprop;
804: return(0);
805: }
807: static PetscErrorCode ISCopyInfo(IS source, IS dest)
808: {
812: PetscArraycpy(&dest->info[0], &source->info[0], 2);
813: PetscArraycpy(&dest->info_permanent[0], &source->info_permanent[0], 2);
814: return(0);
815: }
817: /*@
818: ISIdentity - Determines whether index set is the identity mapping.
820: Collective on IS
822: Input Parmeters:
823: . is - the index set
825: Output Parameters:
826: . ident - PETSC_TRUE if an identity, else PETSC_FALSE
828: Level: intermediate
830: Note: If ISSetIdentity() (or ISSetInfo() for a permanent property) has been called,
831: ISIdentity() will return its answer without communication between processes, but
832: otherwise the output ident will be computed from ISGetInfo(),
833: which may require synchronization on the communicator of IS. To avoid this computation,
834: call ISGetInfo() directly with the compute flag set to PETSC_FALSE, and ident will be assumed false.
836: .seealso: ISSetIdentity(), ISGetInfo()
837: @*/
838: PetscErrorCode ISIdentity(IS is,PetscBool *ident)
839: {
845: ISGetInfo(is,IS_IDENTITY,IS_GLOBAL,PETSC_TRUE,ident);
846: return(0);
847: }
849: /*@
850: ISSetIdentity - Informs the index set that it is an identity.
852: Logically Collective on IS
854: Input Parmeters:
855: . is - the index set
857: Level: intermediate
859: Note: The IS will be considered the identity permanently, even if indices have been changes (for example, with
860: ISGeneralSetIndices()). It's a good idea to only set this property if the IS will not change in the future.
861: To clear this property, use ISClearInfoCache().
863: .seealso: ISIdentity(), ISSetInfo(), ISClearInfoCache()
864: @*/
865: PetscErrorCode ISSetIdentity(IS is)
866: {
871: ISSetInfo(is,IS_IDENTITY,IS_GLOBAL,PETSC_TRUE,PETSC_TRUE);
872: return(0);
873: }
875: /*@
876: ISContiguousLocal - Locates an index set with contiguous range within a global range, if possible
878: Not Collective
880: Input Parmeters:
881: + is - the index set
882: . gstart - global start
883: - gend - global end
885: Output Parameters:
886: + start - start of contiguous block, as an offset from gstart
887: - contig - PETSC_TRUE if the index set refers to contiguous entries on this process, else PETSC_FALSE
889: Level: developer
891: .seealso: ISGetLocalSize(), VecGetOwnershipRange()
892: @*/
893: PetscErrorCode ISContiguousLocal(IS is,PetscInt gstart,PetscInt gend,PetscInt *start,PetscBool *contig)
894: {
901: if (is->ops->contiguous) {
902: (*is->ops->contiguous)(is,gstart,gend,start,contig);
903: } else {
904: *start = -1;
905: *contig = PETSC_FALSE;
906: }
907: return(0);
908: }
910: /*@
911: ISPermutation - PETSC_TRUE or PETSC_FALSE depending on whether the
912: index set has been declared to be a permutation.
914: Logically Collective on IS
916: Input Parmeters:
917: . is - the index set
919: Output Parameters:
920: . perm - PETSC_TRUE if a permutation, else PETSC_FALSE
922: Level: intermediate
924: Note: If it is not alread known that the IS is a permutation (if ISSetPermutation()
925: or ISSetInfo() has not been called), this routine will not attempt to compute
926: whether the index set is a permutation and will assume perm is PETSC_FALSE.
927: To compute the value when it is not already known, use ISGetInfo() with
928: the compute flag set to PETSC_TRUE.
930: .seealso: ISSetPermutation(), ISGetInfo()
931: @*/
932: PetscErrorCode ISPermutation(IS is,PetscBool *perm)
933: {
939: ISGetInfo(is,IS_PERMUTATION,IS_GLOBAL,PETSC_FALSE,perm);
940: return(0);
941: }
943: /*@
944: ISSetPermutation - Informs the index set that it is a permutation.
946: Logically Collective on IS
948: Input Parmeters:
949: . is - the index set
951: Level: intermediate
954: The debug version of the libraries (./configure --with-debugging=1) checks if the
955: index set is actually a permutation. The optimized version just believes you.
957: Note: The IS will be considered a permutation permanently, even if indices have been changes (for example, with
958: ISGeneralSetIndices()). It's a good idea to only set this property if the IS will not change in the future.
959: To clear this property, use ISClearInfoCache().
961: .seealso: ISPermutation(), ISSetInfo(), ISClearInfoCache().
962: @*/
963: PetscErrorCode ISSetPermutation(IS is)
964: {
969: #if defined(PETSC_USE_DEBUG)
970: {
971: PetscMPIInt size;
973: MPI_Comm_size(PetscObjectComm((PetscObject)is),&size);
974: if (size == 1) {
975: PetscInt i,n,*idx;
976: const PetscInt *iidx;
978: ISGetSize(is,&n);
979: PetscMalloc1(n,&idx);
980: ISGetIndices(is,&iidx);
981: PetscArraycpy(idx,iidx,n);
982: PetscSortInt(n,idx);
983: for (i=0; i<n; i++) {
984: if (idx[i] != i) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Index set is not a permutation");
985: }
986: PetscFree(idx);
987: ISRestoreIndices(is,&iidx);
988: }
989: }
990: #endif
991: ISSetInfo(is,IS_PERMUTATION,IS_GLOBAL,PETSC_TRUE,PETSC_TRUE);
992: return(0);
993: }
995: /*@
996: ISDestroy - Destroys an index set.
998: Collective on IS
1000: Input Parameters:
1001: . is - the index set
1003: Level: beginner
1005: .seealso: ISCreateGeneral(), ISCreateStride(), ISCreateBlocked()
1006: @*/
1007: PetscErrorCode ISDestroy(IS *is)
1008: {
1012: if (!*is) return(0);
1014: if (--((PetscObject)(*is))->refct > 0) {*is = 0; return(0);}
1015: if ((*is)->complement) {
1016: PetscInt refcnt;
1017: PetscObjectGetReference((PetscObject)((*is)->complement), &refcnt);
1018: if (refcnt > 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Nonlocal IS has not been restored");
1019: ISDestroy(&(*is)->complement);
1020: }
1021: if ((*is)->ops->destroy) {
1022: (*(*is)->ops->destroy)(*is);
1023: }
1024: PetscLayoutDestroy(&(*is)->map);
1025: /* Destroy local representations of offproc data. */
1026: PetscFree((*is)->total);
1027: PetscFree((*is)->nonlocal);
1028: PetscHeaderDestroy(is);
1029: return(0);
1030: }
1032: /*@
1033: ISInvertPermutation - Creates a new permutation that is the inverse of
1034: a given permutation.
1036: Collective on IS
1038: Input Parameter:
1039: + is - the index set
1040: - nlocal - number of indices on this processor in result (ignored for 1 proccessor) or
1041: use PETSC_DECIDE
1043: Output Parameter:
1044: . isout - the inverse permutation
1046: Level: intermediate
1048: Notes:
1049: For parallel index sets this does the complete parallel permutation, but the
1050: code is not efficient for huge index sets (10,000,000 indices).
1052: @*/
1053: PetscErrorCode ISInvertPermutation(IS is,PetscInt nlocal,IS *isout)
1054: {
1055: PetscBool isperm, isidentity, issame;
1061: ISGetInfo(is,IS_PERMUTATION,IS_GLOBAL,PETSC_TRUE,&isperm);
1062: if (!isperm) SETERRQ(PetscObjectComm((PetscObject)is),PETSC_ERR_ARG_WRONG,"Not a permutation");
1063: ISGetInfo(is,IS_IDENTITY,IS_GLOBAL,PETSC_TRUE,&isidentity);
1064: issame = PETSC_FALSE;
1065: if (isidentity) {
1066: PetscInt n;
1067: PetscBool isallsame;
1069: ISGetLocalSize(is, &n);
1070: issame = (PetscBool) (n == nlocal);
1071: MPI_Allreduce(&issame, &isallsame, 1, MPIU_BOOL, MPI_LAND, PetscObjectComm((PetscObject)is));
1072: issame = isallsame;
1073: }
1074: if (issame) {
1075: ISDuplicate(is,isout);
1076: } else {
1077: (*is->ops->invertpermutation)(is,nlocal,isout);
1078: ISSetPermutation(*isout);
1079: }
1080: return(0);
1081: }
1083: /*@
1084: ISGetSize - Returns the global length of an index set.
1086: Not Collective
1088: Input Parameter:
1089: . is - the index set
1091: Output Parameter:
1092: . size - the global size
1094: Level: beginner
1097: @*/
1098: PetscErrorCode ISGetSize(IS is,PetscInt *size)
1099: {
1103: *size = is->map->N;
1104: return(0);
1105: }
1107: /*@
1108: ISGetLocalSize - Returns the local (processor) length of an index set.
1110: Not Collective
1112: Input Parameter:
1113: . is - the index set
1115: Output Parameter:
1116: . size - the local size
1118: Level: beginner
1120: @*/
1121: PetscErrorCode ISGetLocalSize(IS is,PetscInt *size)
1122: {
1126: *size = is->map->n;
1127: return(0);
1128: }
1130: /*@
1131: ISGetLayout - get PetscLayout describing index set layout
1133: Not Collective
1135: Input Arguments:
1136: . is - the index set
1138: Output Arguments:
1139: . map - the layout
1141: Level: developer
1143: .seealso: ISGetSize(), ISGetLocalSize()
1144: @*/
1145: PetscErrorCode ISGetLayout(IS is,PetscLayout *map)
1146: {
1151: *map = is->map;
1152: return(0);
1153: }
1155: /*@C
1156: ISGetIndices - Returns a pointer to the indices. The user should call
1157: ISRestoreIndices() after having looked at the indices. The user should
1158: NOT change the indices.
1160: Not Collective
1162: Input Parameter:
1163: . is - the index set
1165: Output Parameter:
1166: . ptr - the location to put the pointer to the indices
1168: Fortran Note:
1169: This routine has two different interfaces from Fortran; the first is not recommend, it does not require Fortran 90
1170: $ IS is
1171: $ integer is_array(1)
1172: $ PetscOffset i_is
1173: $ int ierr
1174: $ call ISGetIndices(is,is_array,i_is,ierr)
1175: $
1176: $ Access first local entry in list
1177: $ value = is_array(i_is + 1)
1178: $
1179: $ ...... other code
1180: $ call ISRestoreIndices(is,is_array,i_is,ierr)
1181: The second Fortran interface is recommended.
1182: $ use petscisdef
1183: $ PetscInt, pointer :: array(:)
1184: $ PetscErrorCode ierr
1185: $ IS i
1186: $ call ISGetIndicesF90(i,array,ierr)
1190: See the Fortran chapter of the users manual and
1191: petsc/src/is/[tutorials,tests] for details.
1193: Level: intermediate
1196: .seealso: ISRestoreIndices(), ISGetIndicesF90()
1197: @*/
1198: PetscErrorCode ISGetIndices(IS is,const PetscInt *ptr[])
1199: {
1205: (*is->ops->getindices)(is,ptr);
1206: return(0);
1207: }
1209: /*@C
1210: ISGetMinMax - Gets the minimum and maximum values in an IS
1212: Not Collective
1214: Input Parameter:
1215: . is - the index set
1217: Output Parameter:
1218: + min - the minimum value
1219: - max - the maximum value
1221: Level: intermediate
1223: Notes:
1224: Empty index sets return min=PETSC_MAX_INT and max=PETSC_MIN_INT.
1225: In parallel, it returns the min and max of the local portion of the IS
1228: .seealso: ISGetIndices(), ISRestoreIndices(), ISGetIndicesF90()
1229: @*/
1230: PetscErrorCode ISGetMinMax(IS is,PetscInt *min,PetscInt *max)
1231: {
1234: if (min) *min = is->min;
1235: if (max) *max = is->max;
1236: return(0);
1237: }
1239: /*@
1240: ISLocate - determine the location of an index within the local component of an index set
1242: Not Collective
1244: Input Parameter:
1245: + is - the index set
1246: - key - the search key
1248: Output Parameter:
1249: . location - if >= 0, a location within the index set that is equal to the key, otherwise the key is not in the index set
1251: Level: intermediate
1252: @*/
1253: PetscErrorCode ISLocate(IS is, PetscInt key, PetscInt *location)
1254: {
1258: if (is->ops->locate) {
1259: (*is->ops->locate)(is,key,location);
1260: } else {
1261: PetscInt numIdx;
1262: PetscBool sorted;
1263: const PetscInt *idx;
1265: ISGetLocalSize(is,&numIdx);
1266: ISGetIndices(is,&idx);
1267: ISSorted(is,&sorted);
1268: if (sorted) {
1269: PetscFindInt(key,numIdx,idx,location);
1270: } else {
1271: PetscInt i;
1273: *location = -1;
1274: for (i = 0; i < numIdx; i++) {
1275: if (idx[i] == key) {
1276: *location = i;
1277: break;
1278: }
1279: }
1280: }
1281: ISRestoreIndices(is,&idx);
1282: }
1283: return(0);
1284: }
1286: /*@C
1287: ISRestoreIndices - Restores an index set to a usable state after a call
1288: to ISGetIndices().
1290: Not Collective
1292: Input Parameters:
1293: + is - the index set
1294: - ptr - the pointer obtained by ISGetIndices()
1296: Fortran Note:
1297: This routine is used differently from Fortran
1298: $ IS is
1299: $ integer is_array(1)
1300: $ PetscOffset i_is
1301: $ int ierr
1302: $ call ISGetIndices(is,is_array,i_is,ierr)
1303: $
1304: $ Access first local entry in list
1305: $ value = is_array(i_is + 1)
1306: $
1307: $ ...... other code
1308: $ call ISRestoreIndices(is,is_array,i_is,ierr)
1310: See the Fortran chapter of the users manual and
1311: petsc/src/vec/is/tests for details.
1313: Level: intermediate
1315: Note:
1316: This routine zeros out ptr. This is to prevent accidental us of the array after it has been restored.
1318: .seealso: ISGetIndices(), ISRestoreIndicesF90()
1319: @*/
1320: PetscErrorCode ISRestoreIndices(IS is,const PetscInt *ptr[])
1321: {
1327: if (is->ops->restoreindices) {
1328: (*is->ops->restoreindices)(is,ptr);
1329: }
1330: return(0);
1331: }
1333: static PetscErrorCode ISGatherTotal_Private(IS is)
1334: {
1336: PetscInt i,n,N;
1337: const PetscInt *lindices;
1338: MPI_Comm comm;
1339: PetscMPIInt rank,size,*sizes = NULL,*offsets = NULL,nn;
1344: PetscObjectGetComm((PetscObject)is,&comm);
1345: MPI_Comm_size(comm,&size);
1346: MPI_Comm_rank(comm,&rank);
1347: ISGetLocalSize(is,&n);
1348: PetscMalloc2(size,&sizes,size,&offsets);
1350: PetscMPIIntCast(n,&nn);
1351: MPI_Allgather(&nn,1,MPI_INT,sizes,1,MPI_INT,comm);
1352: offsets[0] = 0;
1353: for (i=1; i<size; ++i) offsets[i] = offsets[i-1] + sizes[i-1];
1354: N = offsets[size-1] + sizes[size-1];
1356: PetscMalloc1(N,&(is->total));
1357: ISGetIndices(is,&lindices);
1358: MPI_Allgatherv((void*)lindices,nn,MPIU_INT,is->total,sizes,offsets,MPIU_INT,comm);
1359: ISRestoreIndices(is,&lindices);
1360: is->local_offset = offsets[rank];
1361: PetscFree2(sizes,offsets);
1362: return(0);
1363: }
1365: /*@C
1366: ISGetTotalIndices - Retrieve an array containing all indices across the communicator.
1368: Collective on IS
1370: Input Parameter:
1371: . is - the index set
1373: Output Parameter:
1374: . indices - total indices with rank 0 indices first, and so on; total array size is
1375: the same as returned with ISGetSize().
1377: Level: intermediate
1379: Notes:
1380: this is potentially nonscalable, but depends on the size of the total index set
1381: and the size of the communicator. This may be feasible for index sets defined on
1382: subcommunicators, such that the set size does not grow with PETSC_WORLD_COMM.
1383: Note also that there is no way to tell where the local part of the indices starts
1384: (use ISGetIndices() and ISGetNonlocalIndices() to retrieve just the local and just
1385: the nonlocal part (complement), respectively).
1387: .seealso: ISRestoreTotalIndices(), ISGetNonlocalIndices(), ISGetSize()
1388: @*/
1389: PetscErrorCode ISGetTotalIndices(IS is, const PetscInt *indices[])
1390: {
1392: PetscMPIInt size;
1397: MPI_Comm_size(PetscObjectComm((PetscObject)is), &size);
1398: if (size == 1) {
1399: (*is->ops->getindices)(is,indices);
1400: } else {
1401: if (!is->total) {
1402: ISGatherTotal_Private(is);
1403: }
1404: *indices = is->total;
1405: }
1406: return(0);
1407: }
1409: /*@C
1410: ISRestoreTotalIndices - Restore the index array obtained with ISGetTotalIndices().
1412: Not Collective.
1414: Input Parameter:
1415: + is - the index set
1416: - indices - index array; must be the array obtained with ISGetTotalIndices()
1418: Level: intermediate
1420: .seealso: ISRestoreTotalIndices(), ISGetNonlocalIndices()
1421: @*/
1422: PetscErrorCode ISRestoreTotalIndices(IS is, const PetscInt *indices[])
1423: {
1425: PetscMPIInt size;
1430: MPI_Comm_size(PetscObjectComm((PetscObject)is), &size);
1431: if (size == 1) {
1432: (*is->ops->restoreindices)(is,indices);
1433: } else {
1434: if (is->total != *indices) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Index array pointer being restored does not point to the array obtained from the IS.");
1435: }
1436: return(0);
1437: }
1438: /*@C
1439: ISGetNonlocalIndices - Retrieve an array of indices from remote processors
1440: in this communicator.
1442: Collective on IS
1444: Input Parameter:
1445: . is - the index set
1447: Output Parameter:
1448: . indices - indices with rank 0 indices first, and so on, omitting
1449: the current rank. Total number of indices is the difference
1450: total and local, obtained with ISGetSize() and ISGetLocalSize(),
1451: respectively.
1453: Level: intermediate
1455: Notes:
1456: restore the indices using ISRestoreNonlocalIndices().
1457: The same scalability considerations as those for ISGetTotalIndices
1458: apply here.
1460: .seealso: ISGetTotalIndices(), ISRestoreNonlocalIndices(), ISGetSize(), ISGetLocalSize().
1461: @*/
1462: PetscErrorCode ISGetNonlocalIndices(IS is, const PetscInt *indices[])
1463: {
1465: PetscMPIInt size;
1466: PetscInt n, N;
1471: MPI_Comm_size(PetscObjectComm((PetscObject)is), &size);
1472: if (size == 1) *indices = NULL;
1473: else {
1474: if (!is->total) {
1475: ISGatherTotal_Private(is);
1476: }
1477: ISGetLocalSize(is,&n);
1478: ISGetSize(is,&N);
1479: PetscMalloc1(N-n, &(is->nonlocal));
1480: PetscArraycpy(is->nonlocal, is->total, is->local_offset);
1481: PetscArraycpy(is->nonlocal+is->local_offset, is->total+is->local_offset+n,N - is->local_offset - n);
1482: *indices = is->nonlocal;
1483: }
1484: return(0);
1485: }
1487: /*@C
1488: ISRestoreTotalIndices - Restore the index array obtained with ISGetNonlocalIndices().
1490: Not Collective.
1492: Input Parameter:
1493: + is - the index set
1494: - indices - index array; must be the array obtained with ISGetNonlocalIndices()
1496: Level: intermediate
1498: .seealso: ISGetTotalIndices(), ISGetNonlocalIndices(), ISRestoreTotalIndices()
1499: @*/
1500: PetscErrorCode ISRestoreNonlocalIndices(IS is, const PetscInt *indices[])
1501: {
1505: if (is->nonlocal != *indices) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Index array pointer being restored does not point to the array obtained from the IS.");
1506: return(0);
1507: }
1509: /*@
1510: ISGetNonlocalIS - Gather all nonlocal indices for this IS and present
1511: them as another sequential index set.
1514: Collective on IS
1516: Input Parameter:
1517: . is - the index set
1519: Output Parameter:
1520: . complement - sequential IS with indices identical to the result of
1521: ISGetNonlocalIndices()
1523: Level: intermediate
1525: Notes:
1526: complement represents the result of ISGetNonlocalIndices as an IS.
1527: Therefore scalability issues similar to ISGetNonlocalIndices apply.
1528: The resulting IS must be restored using ISRestoreNonlocalIS().
1530: .seealso: ISGetNonlocalIndices(), ISRestoreNonlocalIndices(), ISAllGather(), ISGetSize()
1531: @*/
1532: PetscErrorCode ISGetNonlocalIS(IS is, IS *complement)
1533: {
1539: /* Check if the complement exists already. */
1540: if (is->complement) {
1541: *complement = is->complement;
1542: PetscObjectReference((PetscObject)(is->complement));
1543: } else {
1544: PetscInt N, n;
1545: const PetscInt *idx;
1546: ISGetSize(is, &N);
1547: ISGetLocalSize(is,&n);
1548: ISGetNonlocalIndices(is, &idx);
1549: ISCreateGeneral(PETSC_COMM_SELF, N-n,idx, PETSC_USE_POINTER, &(is->complement));
1550: PetscObjectReference((PetscObject)is->complement);
1551: *complement = is->complement;
1552: }
1553: return(0);
1554: }
1557: /*@
1558: ISRestoreNonlocalIS - Restore the IS obtained with ISGetNonlocalIS().
1560: Not collective.
1562: Input Parameter:
1563: + is - the index set
1564: - complement - index set of is's nonlocal indices
1566: Level: intermediate
1569: .seealso: ISGetNonlocalIS(), ISGetNonlocalIndices(), ISRestoreNonlocalIndices()
1570: @*/
1571: PetscErrorCode ISRestoreNonlocalIS(IS is, IS *complement)
1572: {
1574: PetscInt refcnt;
1579: if (*complement != is->complement) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Complement IS being restored was not obtained with ISGetNonlocalIS()");
1580: PetscObjectGetReference((PetscObject)(is->complement), &refcnt);
1581: if (refcnt <= 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Duplicate call to ISRestoreNonlocalIS() detected");
1582: PetscObjectDereference((PetscObject)(is->complement));
1583: return(0);
1584: }
1586: /*@C
1587: ISViewFromOptions - View from Options
1589: Collective on IS
1591: Input Parameters:
1592: + A - the index set
1593: . obj - Optional object
1594: - name - command line option
1596: Level: intermediate
1597: .seealso: IS, ISView, PetscObjectViewFromOptions(), ISCreate()
1598: @*/
1599: PetscErrorCode ISViewFromOptions(IS A,PetscObject obj,const char name[])
1600: {
1605: PetscObjectViewFromOptions((PetscObject)A,obj,name);
1606: return(0);
1607: }
1609: /*@C
1610: ISView - Displays an index set.
1612: Collective on IS
1614: Input Parameters:
1615: + is - the index set
1616: - viewer - viewer used to display the set, for example PETSC_VIEWER_STDOUT_SELF.
1618: Level: intermediate
1620: .seealso: PetscViewerASCIIOpen()
1621: @*/
1622: PetscErrorCode ISView(IS is,PetscViewer viewer)
1623: {
1628: if (!viewer) {PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)is),&viewer);}
1632: PetscObjectPrintClassNamePrefixType((PetscObject)is,viewer);
1633: PetscLogEventBegin(IS_View,is,viewer,0,0);
1634: (*is->ops->view)(is,viewer);
1635: PetscLogEventEnd(IS_View,is,viewer,0,0);
1636: return(0);
1637: }
1639: /*@
1640: ISLoad - Loads a vector that has been stored in binary or HDF5 format with ISView().
1642: Collective on PetscViewer
1644: Input Parameters:
1645: + is - the newly loaded vector, this needs to have been created with ISCreate() or some related function before a call to ISLoad().
1646: - viewer - binary file viewer, obtained from PetscViewerBinaryOpen() or HDF5 file viewer, obtained from PetscViewerHDF5Open()
1648: Level: intermediate
1650: Notes:
1651: IF using HDF5, you must assign the IS the same name as was used in the IS
1652: that was stored in the file using PetscObjectSetName(). Otherwise you will
1653: get the error message: "Cannot H5DOpen2() with Vec name NAMEOFOBJECT"
1655: .seealso: PetscViewerBinaryOpen(), ISView(), MatLoad(), VecLoad()
1656: @*/
1657: PetscErrorCode ISLoad(IS is, PetscViewer viewer)
1658: {
1659: PetscBool isbinary, ishdf5;
1666: PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERBINARY, &isbinary);
1667: PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);
1668: if (!isbinary && !ishdf5) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid viewer; open viewer with PetscViewerBinaryOpen()");
1669: if (!((PetscObject)is)->type_name) {ISSetType(is, ISGENERAL);}
1670: PetscLogEventBegin(IS_Load,is,viewer,0,0);
1671: (*is->ops->load)(is, viewer);
1672: PetscLogEventEnd(IS_Load,is,viewer,0,0);
1673: return(0);
1674: }
1676: /*@
1677: ISSort - Sorts the indices of an index set.
1679: Collective on IS
1681: Input Parameters:
1682: . is - the index set
1684: Level: intermediate
1687: .seealso: ISSortRemoveDups(), ISSorted()
1688: @*/
1689: PetscErrorCode ISSort(IS is)
1690: {
1695: (*is->ops->sort)(is);
1696: ISSetInfo(is,IS_SORTED,IS_LOCAL,is->info_permanent[IS_LOCAL][IS_SORTED],PETSC_TRUE);
1697: return(0);
1698: }
1700: /*@
1701: ISSortRemoveDups - Sorts the indices of an index set, removing duplicates.
1703: Collective on IS
1705: Input Parameters:
1706: . is - the index set
1708: Level: intermediate
1711: .seealso: ISSort(), ISSorted()
1712: @*/
1713: PetscErrorCode ISSortRemoveDups(IS is)
1714: {
1719: ISClearInfoCache(is,PETSC_FALSE);
1720: (*is->ops->sortremovedups)(is);
1721: ISSetInfo(is,IS_SORTED,IS_LOCAL,is->info_permanent[IS_LOCAL][IS_SORTED],PETSC_TRUE);
1722: ISSetInfo(is,IS_UNIQUE,IS_LOCAL,is->info_permanent[IS_LOCAL][IS_UNIQUE],PETSC_TRUE);
1723: return(0);
1724: }
1726: /*@
1727: ISToGeneral - Converts an IS object of any type to ISGENERAL type
1729: Collective on IS
1731: Input Parameters:
1732: . is - the index set
1734: Level: intermediate
1737: .seealso: ISSorted()
1738: @*/
1739: PetscErrorCode ISToGeneral(IS is)
1740: {
1745: if (is->ops->togeneral) {
1746: (*is->ops->togeneral)(is);
1747: } else SETERRQ1(PetscObjectComm((PetscObject)is),PETSC_ERR_SUP,"Not written for this type %s",((PetscObject)is)->type_name);
1748: return(0);
1749: }
1751: /*@
1752: ISSorted - Checks the indices to determine whether they have been sorted.
1754: Collective on IS
1756: Input Parameter:
1757: . is - the index set
1759: Output Parameter:
1760: . flg - output flag, either PETSC_TRUE if the index set is sorted,
1761: or PETSC_FALSE otherwise.
1763: Notes:
1764: For parallel IS objects this only indicates if the local part of the IS
1765: is sorted. So some processors may return PETSC_TRUE while others may
1766: return PETSC_FALSE.
1768: Level: intermediate
1770: .seealso: ISSort(), ISSortRemoveDups()
1771: @*/
1772: PetscErrorCode ISSorted(IS is,PetscBool *flg)
1773: {
1779: ISGetInfo(is,IS_SORTED,IS_LOCAL,PETSC_TRUE,flg);
1780: return(0);
1781: }
1783: /*@
1784: ISDuplicate - Creates a duplicate copy of an index set.
1786: Collective on IS
1788: Input Parmeters:
1789: . is - the index set
1791: Output Parameters:
1792: . isnew - the copy of the index set
1794: Level: beginner
1796: .seealso: ISCreateGeneral(), ISCopy()
1797: @*/
1798: PetscErrorCode ISDuplicate(IS is,IS *newIS)
1799: {
1805: (*is->ops->duplicate)(is,newIS);
1806: ISCopyInfo(is,*newIS);
1807: return(0);
1808: }
1810: /*@
1811: ISCopy - Copies an index set.
1813: Collective on IS
1815: Input Parmeters:
1816: . is - the index set
1818: Output Parameters:
1819: . isy - the copy of the index set
1821: Level: beginner
1823: .seealso: ISDuplicate()
1824: @*/
1825: PetscErrorCode ISCopy(IS is,IS isy)
1826: {
1833: if (is == isy) return(0);
1834: ISCopyInfo(is,isy);
1835: isy->max = is->max;
1836: isy->min = is->min;
1837: (*is->ops->copy)(is,isy);
1838: return(0);
1839: }
1841: /*@
1842: ISOnComm - Split a parallel IS on subcomms (usually self) or concatenate index sets on subcomms into a parallel index set
1844: Collective on IS
1846: Input Arguments:
1847: + is - index set
1848: . comm - communicator for new index set
1849: - mode - copy semantics, PETSC_USE_POINTER for no-copy if possible, otherwise PETSC_COPY_VALUES
1851: Output Arguments:
1852: . newis - new IS on comm
1854: Level: advanced
1856: Notes:
1857: It is usually desirable to create a parallel IS and look at the local part when necessary.
1859: This function is useful if serial ISs must be created independently, or to view many
1860: logically independent serial ISs.
1862: The input IS must have the same type on every process.
1864: .seealso: ISSplit()
1865: @*/
1866: PetscErrorCode ISOnComm(IS is,MPI_Comm comm,PetscCopyMode mode,IS *newis)
1867: {
1869: PetscMPIInt match;
1874: MPI_Comm_compare(PetscObjectComm((PetscObject)is),comm,&match);
1875: if (mode != PETSC_COPY_VALUES && (match == MPI_IDENT || match == MPI_CONGRUENT)) {
1876: PetscObjectReference((PetscObject)is);
1877: *newis = is;
1878: } else {
1879: (*is->ops->oncomm)(is,comm,mode,newis);
1880: }
1881: return(0);
1882: }
1884: /*@
1885: ISSetBlockSize - informs an index set that it has a given block size
1887: Logicall Collective on IS
1889: Input Arguments:
1890: + is - index set
1891: - bs - block size
1893: Level: intermediate
1894:
1895: Notes:
1896: This is much like the block size for Vecs. It indicates that one can think of the indices as
1897: being in a collection of equal size blocks. For ISBlock() these collections of blocks are all contiquous
1898: within a block but this is not the case for other IS.
1899: ISBlockGetIndices() only works for ISBlock IS, not others.
1901: .seealso: ISGetBlockSize(), ISCreateBlock(), ISBlockGetIndices(),
1902: @*/
1903: PetscErrorCode ISSetBlockSize(IS is,PetscInt bs)
1904: {
1910: if (bs < 1) SETERRQ1(PetscObjectComm((PetscObject)is),PETSC_ERR_ARG_OUTOFRANGE,"Block size %D, must be positive",bs);
1911: (*is->ops->setblocksize)(is,bs);
1912: return(0);
1913: }
1915: /*@
1916: ISGetBlockSize - Returns the number of elements in a block.
1918: Not Collective
1920: Input Parameter:
1921: . is - the index set
1923: Output Parameter:
1924: . size - the number of elements in a block
1926: Level: intermediate
1928: Notes:
1929: This is much like the block size for Vecs. It indicates that one can think of the indices as
1930: being in a collection of equal size blocks. For ISBlock() these collections of blocks are all contiquous
1931: within a block but this is not the case for other IS.
1932: ISBlockGetIndices() only works for ISBlock IS, not others.
1934: .seealso: ISBlockGetSize(), ISGetSize(), ISCreateBlock(), ISSetBlockSize()
1935: @*/
1936: PetscErrorCode ISGetBlockSize(IS is,PetscInt *size)
1937: {
1941: PetscLayoutGetBlockSize(is->map, size);
1942: return(0);
1943: }
1945: PetscErrorCode ISGetIndicesCopy(IS is, PetscInt idx[])
1946: {
1948: PetscInt len,i;
1949: const PetscInt *ptr;
1952: ISGetLocalSize(is,&len);
1953: ISGetIndices(is,&ptr);
1954: for (i=0; i<len; i++) idx[i] = ptr[i];
1955: ISRestoreIndices(is,&ptr);
1956: return(0);
1957: }
1959: /*MC
1960: ISGetIndicesF90 - Accesses the elements of an index set from Fortran90.
1961: The users should call ISRestoreIndicesF90() after having looked at the
1962: indices. The user should NOT change the indices.
1964: Synopsis:
1965: ISGetIndicesF90(IS x,{integer, pointer :: xx_v(:)},integer ierr)
1967: Not collective
1969: Input Parameter:
1970: . x - index set
1972: Output Parameters:
1973: + xx_v - the Fortran90 pointer to the array
1974: - ierr - error code
1976: Example of Usage:
1977: .vb
1978: PetscInt, pointer xx_v(:)
1979: ....
1980: call ISGetIndicesF90(x,xx_v,ierr)
1981: a = xx_v(3)
1982: call ISRestoreIndicesF90(x,xx_v,ierr)
1983: .ve
1985: Level: intermediate
1987: .seealso: ISRestoreIndicesF90(), ISGetIndices(), ISRestoreIndices()
1990: M*/
1992: /*MC
1993: ISRestoreIndicesF90 - Restores an index set to a usable state after
1994: a call to ISGetIndicesF90().
1996: Synopsis:
1997: ISRestoreIndicesF90(IS x,{integer, pointer :: xx_v(:)},integer ierr)
1999: Not collective
2001: Input Parameters:
2002: + x - index set
2003: - xx_v - the Fortran90 pointer to the array
2005: Output Parameter:
2006: . ierr - error code
2009: Example of Usage:
2010: .vb
2011: PetscInt, pointer xx_v(:)
2012: ....
2013: call ISGetIndicesF90(x,xx_v,ierr)
2014: a = xx_v(3)
2015: call ISRestoreIndicesF90(x,xx_v,ierr)
2016: .ve
2018: Level: intermediate
2020: .seealso: ISGetIndicesF90(), ISGetIndices(), ISRestoreIndices()
2022: M*/
2024: /*MC
2025: ISBlockGetIndicesF90 - Accesses the elements of an index set from Fortran90.
2026: The users should call ISBlockRestoreIndicesF90() after having looked at the
2027: indices. The user should NOT change the indices.
2029: Synopsis:
2030: ISBlockGetIndicesF90(IS x,{integer, pointer :: xx_v(:)},integer ierr)
2032: Not collective
2034: Input Parameter:
2035: . x - index set
2037: Output Parameters:
2038: + xx_v - the Fortran90 pointer to the array
2039: - ierr - error code
2040: Example of Usage:
2041: .vb
2042: PetscInt, pointer xx_v(:)
2043: ....
2044: call ISBlockGetIndicesF90(x,xx_v,ierr)
2045: a = xx_v(3)
2046: call ISBlockRestoreIndicesF90(x,xx_v,ierr)
2047: .ve
2049: Level: intermediate
2051: .seealso: ISBlockRestoreIndicesF90(), ISGetIndices(), ISRestoreIndices(),
2052: ISRestoreIndices()
2054: M*/
2056: /*MC
2057: ISBlockRestoreIndicesF90 - Restores an index set to a usable state after
2058: a call to ISBlockGetIndicesF90().
2060: Synopsis:
2061: ISBlockRestoreIndicesF90(IS x,{integer, pointer :: xx_v(:)},integer ierr)
2063: Not Collective
2065: Input Parameters:
2066: + x - index set
2067: - xx_v - the Fortran90 pointer to the array
2069: Output Parameter:
2070: . ierr - error code
2072: Example of Usage:
2073: .vb
2074: PetscInt, pointer xx_v(:)
2075: ....
2076: call ISBlockGetIndicesF90(x,xx_v,ierr)
2077: a = xx_v(3)
2078: call ISBlockRestoreIndicesF90(x,xx_v,ierr)
2079: .ve
2081: Notes:
2082: Not yet supported for all F90 compilers
2084: Level: intermediate
2086: .seealso: ISBlockGetIndicesF90(), ISGetIndices(), ISRestoreIndices(), ISRestoreIndicesF90()
2088: M*/