Actual source code: aobasic.c
1: #define PETSCDM_DLL
3: /*
4: The most basic AO application ordering routines. These store the
5: entire orderings on each processor.
6: */
8: #include ../src/dm/ao/aoimpl.h
10: typedef struct {
11: PetscInt N;
12: PetscInt *app,*petsc; /* app[i] is the partner for the ith PETSc slot */
13: /* petsc[j] is the partner for the jth app slot */
14: } AO_Basic;
16: /*
17: All processors have the same data so processor 1 prints it
18: */
21: PetscErrorCode AOView_Basic(AO ao,PetscViewer viewer)
22: {
24: PetscMPIInt rank;
25: PetscInt i;
26: AO_Basic *aodebug = (AO_Basic*)ao->data;
27: PetscTruth iascii;
30: MPI_Comm_rank(((PetscObject)ao)->comm,&rank);
31: if (!rank){
32: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
33: if (iascii) {
34: PetscViewerASCIIPrintf(viewer,"Number of elements in ordering %D\n",aodebug->N);
35: PetscViewerASCIIPrintf(viewer, "PETSc->App App->PETSc\n");
36: for (i=0; i<aodebug->N; i++) {
37: PetscViewerASCIIPrintf(viewer,"%3D %3D %3D %3D\n",i,aodebug->app[i],i,aodebug->petsc[i]);
38: }
39: } else {
40: SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported for AO basic",((PetscObject)viewer)->type_name);
41: }
42: }
43: PetscViewerFlush(viewer);
44: return(0);
45: }
49: PetscErrorCode AODestroy_Basic(AO ao)
50: {
51: AO_Basic *aodebug = (AO_Basic*)ao->data;
55: PetscFree2(aodebug->app,aodebug->petsc);
56: PetscFree(ao->data);
57: return(0);
58: }
62: PetscErrorCode AOBasicGetIndices_Private(AO ao,PetscInt **app,PetscInt **petsc)
63: {
64: AO_Basic *basic = (AO_Basic*)ao->data;
67: if (app) *app = basic->app;
68: if (petsc) *petsc = basic->petsc;
69: return(0);
70: }
74: PetscErrorCode AOPetscToApplication_Basic(AO ao,PetscInt n,PetscInt *ia)
75: {
76: PetscInt i;
77: AO_Basic *aodebug = (AO_Basic*)ao->data;
80: for (i=0; i<n; i++) {
81: if (ia[i] >= 0) {ia[i] = aodebug->app[ia[i]];}
82: }
83: return(0);
84: }
88: PetscErrorCode AOApplicationToPetsc_Basic(AO ao,PetscInt n,PetscInt *ia)
89: {
90: PetscInt i;
91: AO_Basic *aodebug = (AO_Basic*)ao->data;
94: for (i=0; i<n; i++) {
95: if (ia[i] >= 0) {ia[i] = aodebug->petsc[ia[i]];}
96: }
97: return(0);
98: }
102: PetscErrorCode AOPetscToApplicationPermuteInt_Basic(AO ao, PetscInt block, PetscInt *array)
103: {
104: AO_Basic *aodebug = (AO_Basic *) ao->data;
105: PetscInt *temp;
106: PetscInt i, j;
110: PetscMalloc(aodebug->N*block * sizeof(PetscInt), &temp);
111: for(i = 0; i < aodebug->N; i++) {
112: for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->petsc[i]*block+j];
113: }
114: PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscInt));
115: PetscFree(temp);
116: return(0);
117: }
121: PetscErrorCode AOApplicationToPetscPermuteInt_Basic(AO ao, PetscInt block, PetscInt *array)
122: {
123: AO_Basic *aodebug = (AO_Basic *) ao->data;
124: PetscInt *temp;
125: PetscInt i, j;
129: PetscMalloc(aodebug->N*block * sizeof(PetscInt), &temp);
130: for(i = 0; i < aodebug->N; i++) {
131: for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->app[i]*block+j];
132: }
133: PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscInt));
134: PetscFree(temp);
135: return(0);
136: }
140: PetscErrorCode AOPetscToApplicationPermuteReal_Basic(AO ao, PetscInt block, PetscReal *array)
141: {
142: AO_Basic *aodebug = (AO_Basic *) ao->data;
143: PetscReal *temp;
144: PetscInt i, j;
148: PetscMalloc(aodebug->N*block * sizeof(PetscReal), &temp);
149: for(i = 0; i < aodebug->N; i++) {
150: for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->petsc[i]*block+j];
151: }
152: PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscReal));
153: PetscFree(temp);
154: return(0);
155: }
159: PetscErrorCode AOApplicationToPetscPermuteReal_Basic(AO ao, PetscInt block, PetscReal *array)
160: {
161: AO_Basic *aodebug = (AO_Basic *) ao->data;
162: PetscReal *temp;
163: PetscInt i, j;
167: PetscMalloc(aodebug->N*block * sizeof(PetscReal), &temp);
168: for(i = 0; i < aodebug->N; i++) {
169: for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->app[i]*block+j];
170: }
171: PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscReal));
172: PetscFree(temp);
173: return(0);
174: }
176: static struct _AOOps AOops = {AOView_Basic,
177: AODestroy_Basic,
178: AOPetscToApplication_Basic,
179: AOApplicationToPetsc_Basic,
180: AOPetscToApplicationPermuteInt_Basic,
181: AOApplicationToPetscPermuteInt_Basic,
182: AOPetscToApplicationPermuteReal_Basic,
183: AOApplicationToPetscPermuteReal_Basic};
187: /*@C
188: AOCreateBasic - Creates a basic application ordering using two integer arrays.
190: Collective on MPI_Comm
192: Input Parameters:
193: + comm - MPI communicator that is to share AO
194: . napp - size of integer arrays
195: . myapp - integer array that defines an ordering
196: - mypetsc - integer array that defines another ordering (may be PETSC_NULL to
197: indicate the natural ordering, that is 0,1,2,3,...)
199: Output Parameter:
200: . aoout - the new application ordering
202: Options Database Key:
203: . -ao_view - call AOView() at the conclusion of AOCreateBasic()
205: Level: beginner
207: 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"
208: in the indices. Use AOCreateMapping() or AOCreateMappingIS() if you wish to have "holes" in the indices.
210: .keywords: AO, create
212: .seealso: AOCreateBasicIS(), AODestroy(), AOPetscToApplication(), AOApplicationToPetsc()
213: @*/
214: PetscErrorCode AOCreateBasic(MPI_Comm comm,PetscInt napp,const PetscInt myapp[],const PetscInt mypetsc[],AO *aoout)
215: {
216: AO_Basic *aobasic;
217: AO ao;
218: PetscMPIInt *lens,size,rank,nnapp,*disp;
219: PetscInt *allpetsc,*allapp,ip,ia,N,i,*petsc,start;
220: PetscTruth opt;
225: *aoout = 0;
226: #ifndef PETSC_USE_DYNAMIC_LIBRARIES
227: DMInitializePackage(PETSC_NULL);
228: #endif
230: PetscHeaderCreate(ao, _p_AO, struct _AOOps, AO_COOKIE, AO_BASIC, "AO", comm, AODestroy, AOView);
231: PetscNewLog(ao, AO_Basic, &aobasic);
233: PetscMemcpy(ao->ops, &AOops, sizeof(AOops));
234: ao->data = (void*) aobasic;
236: /* transmit all lengths to all processors */
237: MPI_Comm_size(comm, &size);
238: MPI_Comm_rank(comm, &rank);
239: PetscMalloc2(size,PetscMPIInt, &lens,size,PetscMPIInt,&disp);
240: nnapp = napp;
241: MPI_Allgather(&nnapp, 1, MPI_INT, lens, 1, MPI_INT, comm);
242: N = 0;
243: for(i = 0; i < size; i++) {
244: disp[i] = N;
245: N += lens[i];
246: }
247: aobasic->N = N;
249: /*
250: If mypetsc is 0 then use "natural" numbering
251: */
252: if (napp && !mypetsc) {
253: start = disp[rank];
254: PetscMalloc((napp+1) * sizeof(PetscInt), &petsc);
255: for (i=0; i<napp; i++) {
256: petsc[i] = start + i;
257: }
258: } else {
259: petsc = (PetscInt*)mypetsc;
260: }
262: /* get all indices on all processors */
263: PetscMalloc2(N,PetscInt, &allpetsc,N,PetscInt,&allapp);
264: MPI_Allgatherv(petsc, napp, MPIU_INT, allpetsc, lens, disp, MPIU_INT, comm);
265: MPI_Allgatherv((void*)myapp, napp, MPIU_INT, allapp, lens, disp, MPIU_INT, comm);
266: PetscFree2(lens,disp);
268: #if defined(PETSC_USE_DEBUG)
269: {
270: PetscInt *sorted;
271: PetscMalloc(N*sizeof(PetscInt),&sorted);
273: PetscMemcpy(sorted,allapp,N*sizeof(PetscInt));
274: PetscSortInt(N,sorted);
275: for (i=0; i<N; i++) {
276: if (sorted[i] != i) SETERRQ2(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]);
277: }
279: PetscMemcpy(sorted,allapp,N*sizeof(PetscInt));
280: PetscSortInt(N,sorted);
281: for (i=0; i<N; i++) {
282: if (sorted[i] != i) SETERRQ2(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]);
283: }
285: PetscFree(sorted);
286: }
287: #endif
289: /* generate a list of application and PETSc node numbers */
290: PetscMalloc2(N,PetscInt, &aobasic->app,N,PetscInt,&aobasic->petsc);
291: PetscLogObjectMemory(ao,2*N*sizeof(PetscInt));
292: PetscMemzero(aobasic->app, N*sizeof(PetscInt));
293: PetscMemzero(aobasic->petsc, N*sizeof(PetscInt));
294: for(i = 0; i < N; i++) {
295: ip = allpetsc[i];
296: ia = allapp[i];
297: /* check there are no duplicates */
298: if (aobasic->app[ip]) SETERRQ3(PETSC_ERR_ARG_OUTOFRANGE,"Duplicate in PETSc ordering at position %d. Already mapped to %d, not %d.", i, aobasic->app[ip]-1, ia);
299: aobasic->app[ip] = ia + 1;
300: if (aobasic->petsc[ia]) SETERRQ3(PETSC_ERR_ARG_OUTOFRANGE,"Duplicate in Application ordering at position %d. Already mapped to %d, not %d.", i, aobasic->petsc[ia]-1, ip);
301: aobasic->petsc[ia] = ip + 1;
302: }
303: if (!mypetsc) {
304: PetscFree(petsc);
305: }
306: PetscFree2(allpetsc,allapp);
307: /* shift indices down by one */
308: for(i = 0; i < N; i++) {
309: aobasic->app[i]--;
310: aobasic->petsc[i]--;
311: }
313: opt = PETSC_FALSE;
314: PetscOptionsGetTruth(PETSC_NULL, "-ao_view", &opt,PETSC_NULL);
315: if (opt) {
316: AOView(ao, PETSC_VIEWER_STDOUT_SELF);
317: }
319: *aoout = ao;
320: return(0);
321: }
325: /*@C
326: AOCreateBasicIS - Creates a basic application ordering using two index sets.
328: Collective on IS
330: Input Parameters:
331: + isapp - index set that defines an ordering
332: - ispetsc - index set that defines another ordering (may be PETSC_NULL to use the
333: natural ordering)
335: Output Parameter:
336: . aoout - the new application ordering
338: Options Database Key:
339: - -ao_view - call AOView() at the conclusion of AOCreateBasicIS()
341: Level: beginner
343: 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;
344: that is there cannot be any "holes"
346: .keywords: AO, create
348: .seealso: AOCreateBasic(), AODestroy()
349: @*/
350: PetscErrorCode AOCreateBasicIS(IS isapp,IS ispetsc,AO *aoout)
351: {
353: const PetscInt *mypetsc = 0,*myapp;
354: PetscInt napp,npetsc;
355: MPI_Comm comm;
358: PetscObjectGetComm((PetscObject)isapp,&comm);
359: ISGetLocalSize(isapp,&napp);
360: if (ispetsc) {
361: ISGetLocalSize(ispetsc,&npetsc);
362: if (napp != npetsc) SETERRQ(PETSC_ERR_ARG_SIZ,"Local IS lengths must match");
363: ISGetIndices(ispetsc,&mypetsc);
364: }
365: ISGetIndices(isapp,&myapp);
367: AOCreateBasic(comm,napp,myapp,mypetsc,aoout);
369: ISRestoreIndices(isapp,&myapp);
370: if (ispetsc) {
371: ISRestoreIndices(ispetsc,&mypetsc);
372: }
373: return(0);
374: }