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