Actual source code: aobasic.c
2: /*
3: The most basic AO application ordering routines. These store the
4: entire orderings on each processor.
5: */
7: #include <../src/dm/ao/aoimpl.h> /*I "petscao.h" I*/
9: typedef struct {
10: PetscInt *app; /* app[i] is the partner for the ith PETSc slot */
11: PetscInt *petsc; /* petsc[j] is the partner for the jth app slot */
12: } AO_Basic;
14: /*
15: All processors have the same data so processor 1 prints it
16: */
19: PetscErrorCode AOView_Basic(AO ao,PetscViewer viewer)
20: {
22: PetscMPIInt rank;
23: PetscInt i;
24: AO_Basic *aobasic = (AO_Basic*)ao->data;
25: PetscBool iascii;
28: MPI_Comm_rank(((PetscObject)ao)->comm,&rank);
29: if (!rank){
30: PetscTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);
31: if (iascii) {
32: PetscViewerASCIIPrintf(viewer,"Number of elements in ordering %D\n",ao->N);
33: PetscViewerASCIIPrintf(viewer, "PETSc->App App->PETSc\n");
34: for (i=0; i<ao->N; i++) {
35: PetscViewerASCIIPrintf(viewer,"%3D %3D %3D %3D\n",i,aobasic->app[i],i,aobasic->petsc[i]);
36: }
37: } else {
38: SETERRQ1(((PetscObject)viewer)->comm,PETSC_ERR_SUP,"Viewer type %s not supported for AO basic",((PetscObject)viewer)->type_name);
39: }
40: }
41: PetscViewerFlush(viewer);
42: return(0);
43: }
47: PetscErrorCode AODestroy_Basic(AO ao)
48: {
49: AO_Basic *aobasic = (AO_Basic*)ao->data;
53: PetscFree2(aobasic->app,aobasic->petsc);
54: PetscFree(aobasic);
55: return(0);
56: }
60: PetscErrorCode AOBasicGetIndices_Private(AO ao,PetscInt **app,PetscInt **petsc)
61: {
62: AO_Basic *basic = (AO_Basic*)ao->data;
65: if (app) *app = basic->app;
66: if (petsc) *petsc = basic->petsc;
67: return(0);
68: }
72: PetscErrorCode AOPetscToApplication_Basic(AO ao,PetscInt n,PetscInt *ia)
73: {
74: PetscInt i,N=ao->N;
75: AO_Basic *aobasic = (AO_Basic*)ao->data;
78: for (i=0; i<n; i++) {
79: if (ia[i] >= 0 && ia[i] < N ) {
80: ia[i] = aobasic->app[ia[i]];
81: } else {
82: ia[i] = -1;
83: }
84: }
85: return(0);
86: }
90: PetscErrorCode AOApplicationToPetsc_Basic(AO ao,PetscInt n,PetscInt *ia)
91: {
92: PetscInt i,N=ao->N;
93: AO_Basic *aobasic = (AO_Basic*)ao->data;
96: for (i=0; i<n; i++) {
97: if (ia[i] >= 0 && ia[i] < N) {
98: ia[i] = aobasic->petsc[ia[i]];
99: } else {
100: ia[i] = -1;
101: }
102: }
103: return(0);
104: }
108: PetscErrorCode AOPetscToApplicationPermuteInt_Basic(AO ao, PetscInt block, PetscInt *array)
109: {
110: AO_Basic *aobasic = (AO_Basic *) ao->data;
111: PetscInt *temp;
112: PetscInt i, j;
116: PetscMalloc(ao->N*block * sizeof(PetscInt), &temp);
117: for(i = 0; i < ao->N; i++) {
118: for(j = 0; j < block; j++) temp[i*block+j] = array[aobasic->petsc[i]*block+j];
119: }
120: PetscMemcpy(array, temp, ao->N*block * sizeof(PetscInt));
121: PetscFree(temp);
122: return(0);
123: }
127: PetscErrorCode AOApplicationToPetscPermuteInt_Basic(AO ao, PetscInt block, PetscInt *array)
128: {
129: AO_Basic *aobasic = (AO_Basic *) ao->data;
130: PetscInt *temp;
131: PetscInt i, j;
135: PetscMalloc(ao->N*block * sizeof(PetscInt), &temp);
136: for(i = 0; i < ao->N; i++) {
137: for(j = 0; j < block; j++) temp[i*block+j] = array[aobasic->app[i]*block+j];
138: }
139: PetscMemcpy(array, temp, ao->N*block * sizeof(PetscInt));
140: PetscFree(temp);
141: return(0);
142: }
146: PetscErrorCode AOPetscToApplicationPermuteReal_Basic(AO ao, PetscInt block, PetscReal *array)
147: {
148: AO_Basic *aobasic = (AO_Basic *) ao->data;
149: PetscReal *temp;
150: PetscInt i, j;
154: PetscMalloc(ao->N*block * sizeof(PetscReal), &temp);
155: for(i = 0; i < ao->N; i++) {
156: for(j = 0; j < block; j++) temp[i*block+j] = array[aobasic->petsc[i]*block+j];
157: }
158: PetscMemcpy(array, temp, ao->N*block * sizeof(PetscReal));
159: PetscFree(temp);
160: return(0);
161: }
165: PetscErrorCode AOApplicationToPetscPermuteReal_Basic(AO ao, PetscInt block, PetscReal *array)
166: {
167: AO_Basic *aobasic = (AO_Basic *) ao->data;
168: PetscReal *temp;
169: PetscInt i, j;
173: PetscMalloc(ao->N*block * sizeof(PetscReal), &temp);
174: for(i = 0; i < ao->N; i++) {
175: for(j = 0; j < block; j++) temp[i*block+j] = array[aobasic->app[i]*block+j];
176: }
177: PetscMemcpy(array, temp, ao->N*block * sizeof(PetscReal));
178: PetscFree(temp);
179: return(0);
180: }
182: static struct _AOOps AOOps_Basic = {
183: AOView_Basic,
184: AODestroy_Basic,
185: AOPetscToApplication_Basic,
186: AOApplicationToPetsc_Basic,
187: AOPetscToApplicationPermuteInt_Basic,
188: AOApplicationToPetscPermuteInt_Basic,
189: AOPetscToApplicationPermuteReal_Basic,
190: AOApplicationToPetscPermuteReal_Basic};
195: PetscErrorCode AOCreate_Basic(AO ao)
196: {
197: AO_Basic *aobasic;
198: PetscMPIInt size,rank,count,*lens,*disp;
199: PetscInt napp,*allpetsc,*allapp,ip,ia,N,i,*petsc=PETSC_NULL,start;
201: IS isapp=ao->isapp,ispetsc=ao->ispetsc;
202: MPI_Comm comm;
203: const PetscInt *myapp,*mypetsc=PETSC_NULL;
206: /* create special struct aobasic */
207: PetscNewLog(ao, AO_Basic, &aobasic);
208: ao->data = (void*) aobasic;
209: PetscMemcpy(ao->ops,&AOOps_Basic,sizeof(struct _AOOps));
210: PetscObjectChangeTypeName((PetscObject)ao,AOBASIC);
212: ISGetLocalSize(isapp,&napp);
213: ISGetIndices(isapp,&myapp);
215: count = PetscMPIIntCast(napp);
217: /* transmit all lengths to all processors */
218: PetscObjectGetComm((PetscObject)isapp,&comm);
219: MPI_Comm_size(comm, &size);
220: MPI_Comm_rank(comm, &rank);
221: PetscMalloc2(size,PetscMPIInt, &lens,size,PetscMPIInt,&disp);
222: MPI_Allgather(&count, 1, MPI_INT, lens, 1, MPI_INT, comm);
223: N = 0;
224: for(i = 0; i < size; i++) {
225: disp[i] = PetscMPIIntCast(N); /* = sum(lens[j]), j< i */
226: N += lens[i];
227: }
228: ao->N = N;
229: ao->n = N;
231: /* If mypetsc is 0 then use "natural" numbering */
232: if (napp){
233: if (!ispetsc) {
234: start = disp[rank];
235: PetscMalloc((napp+1) * sizeof(PetscInt), &petsc);
236: for (i=0; i<napp; i++) petsc[i] = start + i;
237: } else {
238: ISGetIndices(ispetsc,&mypetsc);
239: petsc = (PetscInt*)mypetsc;
240: }
241: }
243: /* get all indices on all processors */
244: PetscMalloc2(N,PetscInt,&allpetsc,N,PetscInt,&allapp);
245: MPI_Allgatherv(petsc, count, MPIU_INT, allpetsc, lens, disp, MPIU_INT, comm);
246: MPI_Allgatherv((void*)myapp, count, MPIU_INT, allapp, lens, disp, MPIU_INT, comm);
247: PetscFree2(lens,disp);
249: #if defined(PETSC_USE_DEBUG)
250: {
251: PetscInt *sorted;
252: PetscMalloc(N*sizeof(PetscInt),&sorted);
254: PetscMemcpy(sorted,allpetsc,N*sizeof(PetscInt));
255: PetscSortInt(N,sorted);
256: for (i=0; i<N; i++) {
257: if (sorted[i] != i) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"PETSc ordering requires a permutation of numbers 0 to N-1\n it is missing %D has %D",i,sorted[i]);
258: }
260: PetscMemcpy(sorted,allapp,N*sizeof(PetscInt));
261: PetscSortInt(N,sorted);
262: for (i=0; i<N; i++) {
263: if (sorted[i] != i) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Application ordering requires a permutation of numbers 0 to N-1\n it is missing %D has %D",i,sorted[i]);
264: }
266: PetscFree(sorted);
267: }
268: #endif
270: /* generate a list of application and PETSc node numbers */
271: PetscMalloc2(N,PetscInt, &aobasic->app,N,PetscInt,&aobasic->petsc);
272: PetscLogObjectMemory(ao,2*N*sizeof(PetscInt));
273: PetscMemzero(aobasic->app, N*sizeof(PetscInt));
274: PetscMemzero(aobasic->petsc, N*sizeof(PetscInt));
275: for(i = 0; i < N; i++) {
276: ip = allpetsc[i];
277: ia = allapp[i];
278: /* check there are no duplicates */
279: if (aobasic->app[ip]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Duplicate in PETSc ordering at position %d. Already mapped to %d, not %d.", i, aobasic->app[ip]-1, ia);
280: aobasic->app[ip] = ia + 1;
281: if (aobasic->petsc[ia]) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Duplicate in Application ordering at position %d. Already mapped to %d, not %d.", i, aobasic->petsc[ia]-1, ip);
282: aobasic->petsc[ia] = ip + 1;
283: }
284: if (napp && !mypetsc) {
285: PetscFree(petsc);
286: }
287: PetscFree2(allpetsc,allapp);
288: /* shift indices down by one */
289: for(i = 0; i < N; i++) {
290: aobasic->app[i]--;
291: aobasic->petsc[i]--;
292: }
294: ISRestoreIndices(isapp,&myapp);
295: if (napp){
296: if (ispetsc){
297: ISRestoreIndices(ispetsc,&mypetsc);
298: } else {
299: PetscFree(petsc);
300: }
301: }
302: return(0);
303: }
308: /*@C
309: AOCreateBasic - Creates a basic application ordering using two integer arrays.
311: Collective on MPI_Comm
313: Input Parameters:
314: + comm - MPI communicator that is to share AO
315: . napp - size of integer arrays
316: . myapp - integer array that defines an ordering
317: - mypetsc - integer array that defines another ordering (may be PETSC_NULL to
318: indicate the natural ordering, that is 0,1,2,3,...)
320: Output Parameter:
321: . aoout - the new application ordering
323: Level: beginner
325: Notes: the arrays myapp and mypetsc must contain the all the integers 0 to napp-1 with no duplicates; that is there cannot be any "holes"
326: in the indices. Use AOCreateMapping() or AOCreateMappingIS() if you wish to have "holes" in the indices.
328: .keywords: AO, create
330: .seealso: AOCreateBasicIS(), AODestroy(), AOPetscToApplication(), AOApplicationToPetsc()
331: @*/
332: PetscErrorCode AOCreateBasic(MPI_Comm comm,PetscInt napp,const PetscInt myapp[],const PetscInt mypetsc[],AO *aoout)
333: {
335: IS isapp,ispetsc;
336: const PetscInt *app=myapp,*petsc=mypetsc;
339: ISCreateGeneral(comm,napp,app,PETSC_USE_POINTER,&isapp);
340: if (mypetsc){
341: ISCreateGeneral(comm,napp,petsc,PETSC_USE_POINTER,&ispetsc);
342: } else {
343: ispetsc = PETSC_NULL;
344: }
345: AOCreateBasicIS(isapp,ispetsc,aoout);
346: ISDestroy(&isapp);
347: if (mypetsc){
348: ISDestroy(&ispetsc);
349: }
350: return(0);
351: }
355: /*@C
356: AOCreateBasicIS - Creates a basic application ordering using two index sets.
358: Collective on IS
360: Input Parameters:
361: + isapp - index set that defines an ordering
362: - ispetsc - index set that defines another ordering (may be PETSC_NULL to use the
363: natural ordering)
365: Output Parameter:
366: . aoout - the new application ordering
368: Level: beginner
370: Notes: the index sets isapp and ispetsc must contain the all the integers 0 to napp-1 (where napp is the length of the index sets) with no duplicates;
371: that is there cannot be any "holes"
373: .keywords: AO, create
375: .seealso: AOCreateBasic(), AODestroy()
376: @*/
377: PetscErrorCode AOCreateBasicIS(IS isapp,IS ispetsc,AO *aoout)
378: {
380: MPI_Comm comm;
381: AO ao;
384: PetscObjectGetComm((PetscObject)isapp,&comm);
385: AOCreate(comm,&ao);
386: AOSetIS(ao,isapp,ispetsc);
387: AOSetType(ao,AOBASIC);
388: *aoout = ao;
389: return(0);
390: }