Actual source code: aobasic.c

  1: /*
  2:     The most basic AO application ordering routines. These store the 
  3:   entire orderings on each processor.
  4: */

 6:  #include src/dm/ao/aoimpl.h
 7:  #include petscsys.h

  9: typedef struct {
 10:   PetscInt N;
 11:   PetscInt *app,*petsc;  /* app[i] is the partner for the ith PETSc slot */
 12:                          /* petsc[j] is the partner for the jth app slot */
 13: } AO_Basic;

 15: /*
 16:        All processors have the same data so processor 1 prints it
 17: */
 20: PetscErrorCode AOView_Basic(AO ao,PetscViewer viewer)
 21: {
 23:   PetscMPIInt    rank;
 24:   PetscInt       i;
 25:   AO_Basic       *aodebug = (AO_Basic*)ao->data;
 26:   PetscTruth     iascii;

 29:   MPI_Comm_rank(ao->comm,&rank);
 30:   if (!rank){
 31:     PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
 32:     if (iascii) {
 33:       PetscViewerASCIIPrintf(viewer,"Number of elements in ordering %D\n",aodebug->N);
 34:       PetscViewerASCIIPrintf(viewer,  "PETSc->App  App->PETSc\n");
 35:       for (i=0; i<aodebug->N; i++) {
 36:         PetscViewerASCIIPrintf(viewer,"%3D  %3D    %3D  %3D\n",i,aodebug->app[i],i,aodebug->petsc[i]);
 37:       }
 38:     } else {
 39:       SETERRQ1(PETSC_ERR_SUP,"Viewer type %s not supported for AOData basic",((PetscObject)viewer)->type_name);
 40:     }
 41:   }
 42:   PetscViewerFlush(viewer);
 43:   return(0);
 44: }

 48: PetscErrorCode AODestroy_Basic(AO ao)
 49: {
 50:   AO_Basic       *aodebug = (AO_Basic*)ao->data;

 54:   PetscFree(aodebug->app);
 55:   PetscFree(ao->data);
 56:   return(0);
 57: }

 61: PetscErrorCode AOBasicGetIndices_Private(AO ao,PetscInt **app,PetscInt **petsc)
 62: {
 63:   AO_Basic *basic = (AO_Basic*)ao->data;

 66:   if (app)   *app   = basic->app;
 67:   if (petsc) *petsc = basic->petsc;
 68:   return(0);
 69: }

 73: PetscErrorCode AOPetscToApplication_Basic(AO ao,PetscInt n,PetscInt *ia)
 74: {
 75:   PetscInt i;
 76:   AO_Basic *aodebug = (AO_Basic*)ao->data;

 79:   for (i=0; i<n; i++) {
 80:     if (ia[i] >= 0) {ia[i] = aodebug->app[ia[i]];}
 81:   }
 82:   return(0);
 83: }

 87: PetscErrorCode AOApplicationToPetsc_Basic(AO ao,PetscInt n,PetscInt *ia)
 88: {
 89:   PetscInt i;
 90:   AO_Basic *aodebug = (AO_Basic*)ao->data;

 93:   for (i=0; i<n; i++) {
 94:     if (ia[i] >= 0) {ia[i] = aodebug->petsc[ia[i]];}
 95:   }
 96:   return(0);
 97: }

101: PetscErrorCode AOPetscToApplicationPermuteInt_Basic(AO ao, PetscInt block, PetscInt *array)
102: {
103:   AO_Basic       *aodebug = (AO_Basic *) ao->data;
104:   PetscInt       *temp;
105:   PetscInt       i, j;

109:   PetscMalloc(aodebug->N*block * sizeof(PetscInt), &temp);
110:   for(i = 0; i < aodebug->N; i++) {
111:     for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->petsc[i]*block+j];
112:   }
113:   PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscInt));
114:   PetscFree(temp);
115:   return(0);
116: }

120: PetscErrorCode AOApplicationToPetscPermuteInt_Basic(AO ao, PetscInt block, PetscInt *array)
121: {
122:   AO_Basic       *aodebug = (AO_Basic *) ao->data;
123:   PetscInt       *temp;
124:   PetscInt       i, j;

128:   PetscMalloc(aodebug->N*block * sizeof(PetscInt), &temp);
129:   for(i = 0; i < aodebug->N; i++) {
130:     for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->app[i]*block+j];
131:   }
132:   PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscInt));
133:   PetscFree(temp);
134:   return(0);
135: }

139: PetscErrorCode AOPetscToApplicationPermuteReal_Basic(AO ao, PetscInt block, PetscReal *array)
140: {
141:   AO_Basic       *aodebug = (AO_Basic *) ao->data;
142:   PetscReal      *temp;
143:   PetscInt       i, j;

147:   PetscMalloc(aodebug->N*block * sizeof(PetscReal), &temp);
148:   for(i = 0; i < aodebug->N; i++) {
149:     for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->petsc[i]*block+j];
150:   }
151:   PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscReal));
152:   PetscFree(temp);
153:   return(0);
154: }

158: PetscErrorCode AOApplicationToPetscPermuteReal_Basic(AO ao, PetscInt block, PetscReal *array)
159: {
160:   AO_Basic       *aodebug = (AO_Basic *) ao->data;
161:   PetscReal      *temp;
162:   PetscInt       i, j;

166:   PetscMalloc(aodebug->N*block * sizeof(PetscReal), &temp);
167:   for(i = 0; i < aodebug->N; i++) {
168:     for(j = 0; j < block; j++) temp[i*block+j] = array[aodebug->app[i]*block+j];
169:   }
170:   PetscMemcpy(array, temp, aodebug->N*block * sizeof(PetscReal));
171:   PetscFree(temp);
172:   return(0);
173: }

175: static struct _AOOps AOops = {AOView_Basic,
176:                               AODestroy_Basic,
177:                               AOPetscToApplication_Basic,
178:                               AOApplicationToPetsc_Basic,
179:                               AOPetscToApplicationPermuteInt_Basic,
180:                               AOApplicationToPetscPermuteInt_Basic,
181:                               AOPetscToApplicationPermuteReal_Basic,
182:                               AOApplicationToPetscPermuteReal_Basic};

186: /*@C
187:    AOCreateBasic - Creates a basic application ordering using two integer arrays.

189:    Collective on MPI_Comm

191:    Input Parameters:
192: +  comm - MPI communicator that is to share AO
193: .  napp - size of integer arrays
194: .  myapp - integer array that defines an ordering
195: -  mypetsc - integer array that defines another ordering (may be PETSC_NULL to 
196:              indicate the natural ordering)

198:    Output Parameter:
199: .  aoout - the new application ordering

201:    Options Database Key:
202: .   -ao_view - call AOView() at the conclusion of AOCreateBasic()

204:    Level: beginner

206: .keywords: AO, create

208: .seealso: AOCreateBasicIS(), AODestroy()
209: @*/
210: PetscErrorCode AOCreateBasic(MPI_Comm comm,PetscInt napp,const PetscInt myapp[],const PetscInt mypetsc[],AO *aoout)
211: {
212:   AO_Basic       *aobasic;
213:   AO             ao;
214:   PetscMPIInt    *lens,size,rank,nnapp,*disp;
215:   PetscInt       *allpetsc,*allapp,ip,ia,N,i,*petsc,start;
216:   PetscTruth     opt;

221:   *aoout = 0;
222: #ifndef PETSC_USE_DYNAMIC_LIBRARIES
223:   DMInitializePackage(PETSC_NULL);
224: #endif

226:   PetscHeaderCreate(ao, _p_AO, struct _AOOps, AO_COOKIE, AO_BASIC, "AO", comm, AODestroy, AOView);
227:   PetscLogObjectCreate(ao);
228:   PetscNew(AO_Basic, &aobasic);
229:   PetscLogObjectMemory(ao, sizeof(struct _p_AO) + sizeof(AO_Basic));

231:   PetscMemcpy(ao->ops, &AOops, sizeof(AOops));
232:   ao->data = (void*) aobasic;

234:   /* transmit all lengths to all processors */
235:   MPI_Comm_size(comm, &size);
236:   MPI_Comm_rank(comm, &rank);
237:   PetscMalloc(2*size * sizeof(PetscMPIInt), &lens);
238:   disp  = lens + size;
239:   nnapp = napp;
240:   MPI_Allgather(&nnapp, 1, MPI_INT, lens, 1, MPI_INT, comm);
241:   N    =  0;
242:   for(i = 0; i < size; i++) {
243:     disp[i] = N;
244:     N += lens[i];
245:   }
246:   aobasic->N = N;

248:   /*
249:      If mypetsc is 0 then use "natural" numbering 
250:   */
251:   if (!mypetsc) {
252:     start = disp[rank];
253:     PetscMalloc((napp+1) * sizeof(PetscInt), &petsc);
254:     for (i=0; i<napp; i++) {
255:       petsc[i] = start + i;
256:     }
257:   } else {
258:     petsc = (PetscInt*)mypetsc;
259:   }

261:   /* get all indices on all processors */
262:   PetscMalloc(2*N * sizeof(PetscInt), &allpetsc);
263:   allapp = allpetsc + N;
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:   PetscFree(lens);

268:   /* generate a list of application and PETSc node numbers */
269:   PetscMalloc(2*N * sizeof(PetscInt), &aobasic->app);
270:   PetscLogObjectMemory(ao,2*N*sizeof(PetscInt));
271:   aobasic->petsc = aobasic->app + N;
272:   PetscMemzero(aobasic->app, 2*N*sizeof(PetscInt));
273:   for(i = 0; i < N; i++) {
274:     ip = allpetsc[i];
275:     ia = allapp[i];
276:     /* check there are no duplicates */
277:     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);
278:     aobasic->app[ip] = ia + 1;
279:     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);
280:     aobasic->petsc[ia] = ip + 1;
281:   }
282:   if (!mypetsc) {
283:     PetscFree(petsc);
284:   }
285:   PetscFree(allpetsc);
286:   /* shift indices down by one */
287:   for(i = 0; i < N; i++) {
288:     aobasic->app[i]--;
289:     aobasic->petsc[i]--;
290:   }

292:   PetscOptionsHasName(PETSC_NULL, "-ao_view", &opt);
293:   if (opt) {
294:     AOView(ao, PETSC_VIEWER_STDOUT_SELF);
295:   }

297:   *aoout = ao;
298:   return(0);
299: }

303: /*@C
304:    AOCreateBasicIS - Creates a basic application ordering using two index sets.

306:    Collective on IS

308:    Input Parameters:
309: +  isapp - index set that defines an ordering
310: -  ispetsc - index set that defines another ordering (may be PETSC_NULL to use the
311:              natural ordering)

313:    Output Parameter:
314: .  aoout - the new application ordering

316:    Options Database Key:
317: -   -ao_view - call AOView() at the conclusion of AOCreateBasicIS()

319:    Level: beginner

321: .keywords: AO, create

323: .seealso: AOCreateBasic(),  AODestroy()
324: @*/
325: PetscErrorCode AOCreateBasicIS(IS isapp,IS ispetsc,AO *aoout)
326: {
328:   PetscInt       *mypetsc = 0,*myapp,napp,npetsc;
329:   MPI_Comm       comm;

332:   PetscObjectGetComm((PetscObject)isapp,&comm);
333:   ISGetLocalSize(isapp,&napp);
334:   if (ispetsc) {
335:     ISGetLocalSize(ispetsc,&npetsc);
336:     if (napp != npetsc) SETERRQ(PETSC_ERR_ARG_SIZ,"Local IS lengths must match");
337:     ISGetIndices(ispetsc,&mypetsc);
338:   }
339:   ISGetIndices(isapp,&myapp);

341:   AOCreateBasic(comm,napp,myapp,mypetsc,aoout);

343:   ISRestoreIndices(isapp,&myapp);
344:   if (ispetsc) {
345:     ISRestoreIndices(ispetsc,&mypetsc);
346:   }
347:   return(0);
348: }