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: }