Actual source code: aodatabasic.c

  1: /*$Id: aodatabasic.c,v 1.64 2001/08/07 03:04:35 balay Exp $*/

  3: /*
  4:   The most basic AOData routines. These store the entire database on each processor.
  5:   These routines are very simple; note that we do not even use a private data structure
  6:   for AOData, and the private datastructure for AODataSegment is just used as a simple array.

  8:   These are made slightly complicated by having to be able to handle logical variables
  9:   stored in bit arrays. Thus,
 10:     - Before mallocing to hold a bit array, we shrunk the array length by a factor
 11:       of 8 using PetscBTLength()
 12:     - We use PetscBitMemcpy() to allow us to copy at the individual bit level;
 13:       for regular datatypes this just does a regular memcpy().
 14: */

 16:  #include src/dm/ao/aoimpl.h
 17:  #include petscsys.h
 18:  #include petscbt.h

 20: int AODataDestroy_Basic(AOData ao)
 21: {
 22:   int           ierr;
 23:   AODataKey     *key = ao->keys,*nextkey;
 24:   AODataSegment *seg,*nextseg;

 27:   /* if memory was published with AMS then destroy it */
 28:   PetscObjectDepublish(ao);

 30:   while (key) {
 31:     PetscFree(key->name);
 32:     if (key->ltog) {
 33:       ISLocalToGlobalMappingDestroy(key->ltog);
 34:     }
 35:     seg = key->segments;
 36:     while (seg) {
 37:       ierr    = PetscFree(seg->data);
 38:       ierr    = PetscFree(seg->name);
 39:       nextseg = seg->next;
 40:       ierr    = PetscFree(seg);
 41:       seg     = nextseg;
 42:     }
 43:     PetscFree(key->rowners);
 44:     nextkey = key->next;
 45:     PetscFree(key);
 46:     key     = nextkey;
 47:   }
 48: 
 49:   PetscLogObjectDestroy(ao);
 50:   PetscHeaderDestroy(ao);
 51:   return(0);
 52: }

 54: int AODataView_Basic_Binary(AOData ao,PetscViewer viewer)
 55: {
 56:   int             ierr,N,fd;
 57:   AODataSegment   *segment;
 58:   AODataKey       *key = ao->keys;
 59:   char            paddedname[256];


 63:   ierr  = PetscViewerBinaryGetDescriptor(viewer,&fd);

 65:   /* write out number of keys */
 66:   PetscBinaryWrite(fd,&ao->nkeys,1,PETSC_INT,0);

 68:   while (key) {
 69:     N   = key->N;
 70:     /* 
 71:        Write out name of key - use a fixed length for the name in the binary 
 72:        file to make seeking easier
 73:     */
 74:     PetscMemzero(paddedname,256*sizeof(char));
 75:     PetscStrncpy(paddedname,key->name,255);
 76:     PetscBinaryWrite(fd,paddedname,256,PETSC_CHAR,0);
 77:     /* write out the number of indices */
 78:     PetscBinaryWrite(fd,&key->N,1,PETSC_INT,0);
 79:     /* write out number of segments */
 80:     PetscBinaryWrite(fd,&key->nsegments,1,PETSC_INT,0);
 81: 
 82:     /* loop over segments writing them out */
 83:     segment = key->segments;
 84:     while (segment) {
 85:       /* 
 86:          Write out name of segment - use a fixed length for the name in the binary 
 87:          file to make seeking easier
 88:       */
 89:       PetscMemzero(paddedname,256*sizeof(char));
 90:       PetscStrncpy(paddedname,segment->name,255);
 91:       PetscBinaryWrite(fd,paddedname,256,PETSC_CHAR,0);
 92:       PetscBinaryWrite(fd,&segment->bs,1,PETSC_INT,0);
 93:       PetscBinaryWrite(fd,&segment->datatype,1,PETSC_INT,0);
 94:       /* write out the data */
 95:       PetscBinaryWrite(fd,segment->data,N*segment->bs,segment->datatype,0);
 96:       segment = segment->next;
 97:     }
 98:     key = key->next;
 99:   }

101:   return(0);
102: }

104: /*
105:       All processors have the same data so processor 0 prints it
106: */
107: int AODataView_Basic_ASCII(AOData ao,PetscViewer viewer)
108: {
109:   int               ierr,j,k,l,rank,size,nkeys,nsegs,i,N,bs,zero = 0;
110:   char              *dt,**keynames,**segnames,*stype,*segvalue;
111:   AODataSegment     *segment;
112:   AODataKey         *key = ao->keys;
113:   PetscDataType     dtype;
114:   PetscViewerFormat format;

117:   MPI_Comm_rank(ao->comm,&rank);
118:   if (rank) return(0);
119:   MPI_Comm_size(ao->comm,&size);

121:   PetscViewerGetFormat(viewer,&format);
122:   if (format == PETSC_VIEWER_ASCII_INFO) {
123:     AODataGetInfo(ao,&nkeys,&keynames);
124:     for (i=0; i<nkeys; i++) {
125:       AODataKeyGetInfo(ao,keynames[i],&N,0,&nsegs,&segnames);
126:       PetscViewerASCIIPrintf(viewer,"  %s: (%d)n",keynames[i],N);
127:       for (j=0; j<nsegs; j++) {
128:         AODataSegmentGetInfo(ao,keynames[i],segnames[j],&bs,&dtype);
129:         PetscDataTypeGetName(dtype,&stype);
130:         if (dtype == PETSC_CHAR) {
131:           AODataSegmentGet(ao,keynames[i],segnames[j],1,&zero,(void **)&segvalue);
132:           PetscViewerASCIIPrintf(viewer,"      %s: (%d) %s -> %sn",segnames[j],bs,stype,segvalue);
133:           AODataSegmentRestore(ao,keynames[i],segnames[j],1,&zero,(void **)&segvalue);
134:         } else {
135:           PetscViewerASCIIPrintf(viewer,"      %s: (%d) %sn",segnames[j],bs,stype);
136:         }
137:       }
138:     }
139:     PetscFree(keynames);
140:   } else {
141:     PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
142:     while (key) {
143:       PetscViewerASCIIPrintf(viewer,"AOData Key: %s Length %d Ownership: ",key->name,key->N);
144:       for (j=0; j<size+1; j++) {PetscViewerASCIIPrintf(viewer,"%d ",key->rowners[j]);}
145:       PetscViewerASCIIPrintf(viewer,"n");

147:       segment = key->segments;
148:       while (segment) {
149:         PetscDataTypeGetName(segment->datatype,&dt);
150:         PetscViewerASCIIPrintf(viewer,"  AOData Segment: %s Blocksize %d datatype %sn",segment->name,segment->bs,dt);
151:         if (segment->datatype == PETSC_INT) {
152:           int *mdata = (int*)segment->data;
153:           for (k=0; k<key->N; k++) {
154:             PetscViewerASCIIPrintf(viewer," %d: ",k);
155:             for (l=0; l<segment->bs; l++) {
156:               PetscViewerASCIIPrintf(viewer,"   %d ",mdata[k*segment->bs + l]);
157:             }
158:             PetscViewerASCIIPrintf(viewer,"n");
159:           }
160:         } else if (segment->datatype == PETSC_DOUBLE) {
161:           PetscReal *mdata = (PetscReal*)segment->data;
162:           for (k=0; k<key->N; k++) {
163:             PetscViewerASCIIPrintf(viewer," %d: ",k);
164:             for (l=0; l<segment->bs; l++) {
165:               PetscViewerASCIIPrintf(viewer,"   %18.16e ",mdata[k*segment->bs + l]);
166:             }
167:             PetscViewerASCIIPrintf(viewer,"n");
168:           }
169:         } else if (segment->datatype == PETSC_SCALAR) {
170:           PetscScalar *mdata = (PetscScalar*)segment->data;
171:           for (k=0; k<key->N; k++) {
172:             PetscViewerASCIIPrintf(viewer," %d: ",k);
173:             for (l=0; l<segment->bs; l++) {
174: #if !defined(PETSC_USE_COMPLEX)
175:               PetscViewerASCIIPrintf(viewer,"   %18.16e ",mdata[k*segment->bs + l]);
176: #else
177:               PetscScalar x = mdata[k*segment->bs + l];
178:               if (PetscImaginaryPart(x) > 0.0) {
179:                 PetscViewerASCIIPrintf(viewer," %18.16e + %18.16e i n",PetscRealPart(x),PetscImaginaryPart(x));
180:               } else if (PetscImaginaryPart(x) < 0.0) {
181:                 PetscViewerASCIIPrintf(viewer,"   %18.16e - %18.16e i n",PetscRealPart(x),-PetscImaginaryPart(x));
182:               } else {
183:                 PetscViewerASCIIPrintf(viewer,"   %18.16e n",PetscRealPart(x));
184:               }
185: #endif
186:             }
187:           }
188:           PetscViewerASCIIPrintf(viewer,"n");
189:         } else if (segment->datatype == PETSC_LOGICAL) {
190:           PetscBT mdata = (PetscBT) segment->data;
191:           for (k=0; k<key->N; k++) {
192:             PetscViewerASCIIPrintf(viewer," %d: ",k);
193:             for (l=0; l<segment->bs; l++) {
194:               PetscViewerASCIIPrintf(viewer,"   %d ",(int)PetscBTLookup(mdata,k*segment->bs + l));
195:             }
196:             PetscViewerASCIIPrintf(viewer,"n");
197:           }
198:         } else if (segment->datatype == PETSC_CHAR) {
199:           char * mdata = (char*)segment->data;
200:           for (k=0; k<key->N; k++) {
201:             PetscViewerASCIIPrintf(viewer,"  %s ",mdata + k*segment->bs);
202:           }
203:           PetscViewerASCIIPrintf(viewer,"n");
204:         } else {
205:           SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Unknown PETSc data format");
206:         }
207:         segment = segment->next;
208:       }
209:       key = key->next;
210:     }
211:   }
212:   PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
213:   return(0);
214: }

216: int AODataView_Basic(AOData ao,PetscViewer viewer)
217: {
218:   int        rank,ierr;
219:   PetscTruth isascii,isbinary;

222:   MPI_Comm_rank(ao->comm,&rank);
223:   if (rank) return(0);

225:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);
226:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
227:   if (isascii) {
228:     AODataView_Basic_ASCII(ao,viewer);
229:   } else if (isbinary) {
230:     AODataView_Basic_Binary(ao,viewer);
231:   } else {
232:     SETERRQ1(1,"Viewer type %s not supported for AOData basic",((PetscObject)viewer)->type_name);
233:   }

235:   return(0);
236: }

238: int AODataKeyRemove_Basic(AOData aodata,char *name)
239: {
240:   AODataSegment    *segment,*iseg;
241:   AODataKey        *key,*ikey;
242:   int              ierr;
243:   PetscTruth       flag;

246:   AODataKeyFind_Private(aodata,name,&flag,&key);
247:   if (flag != 1)  return(0);
248:   aodata->nkeys--;

250:   segment = key->segments;
251:   while (segment) {
252:     iseg    = segment->next;
253:     PetscFree(segment->name);
254:     PetscFree(segment->data);
255:     PetscFree(segment);
256:     segment = iseg;
257:   }
258:   ikey = aodata->keys;
259:   if (key == ikey) {
260:     aodata->keys = key->next;
261:     goto finishup1;
262:   }
263:   while (ikey->next != key) {
264:     ikey = ikey->next;
265:   }
266:   ikey->next = key->next;

268:   finishup1:

270:   PetscFree(key->name);
271:   PetscFree(key->rowners);
272:   PetscFree(key);

274:   return(0);
275: }

277: int AODataSegmentRemove_Basic(AOData aodata,char *name,char *segname)
278: {
279:   AODataSegment    *segment,*iseg;
280:   AODataKey        *key;
281:   int              ierr;
282:   PetscTruth       flag;

285:   AODataSegmentFind_Private(aodata,name,segname,&flag,&key,&iseg);
286:   if (!flag)  return(0);
287:   key->nsegments--;

289:   segment = key->segments;
290:   if (segment == iseg) {
291:     key->segments = segment->next;
292:     goto finishup2;
293:   }
294:   while (segment->next != iseg) {
295:     segment = segment->next;
296:   }
297:   segment->next = iseg->next;
298:   segment       = iseg;
299: 
300:   finishup2:

302:   PetscFree(segment->name);
303:   PetscFree(segment->data);
304:   PetscFree(segment);
305:   return(0);
306: }


309: int AODataSegmentAdd_Basic(AOData aodata,char *name,char *segname,int bs,int n,int *keys,void *data,PetscDataType dtype)
310: {
311:   AODataSegment    *segment,*iseg;
312:   AODataKey        *key;
313:   int              N,size,ierr,*lens,i,*disp,*akeys,datasize,*fkeys,Nb,j;
314:   MPI_Datatype     mtype;
315:   char             *adata;
316:   MPI_Comm         comm = aodata->comm;
317:   PetscTruth       flag;

320:   ierr  = AODataKeyFind_Private(aodata,name,&flag,&key);
321:   if (!flag)  SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Key %s doesn't exist",name);
322:   AODataSegmentFind_Private(aodata,name,segname,&flag,&key,&iseg);
323:   if (flag)  SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"Segment %s in key %s already exists",name,segname);

325:   PetscNew(AODataSegment,&segment);
326:   if (iseg) {
327:     iseg->next    = segment;
328:   } else {
329:     key->segments = segment;
330:   }
331:   segment->next     = 0;
332:   segment->bs       = bs;
333:   segment->datatype = dtype;

335:   PetscDataTypeGetSize(dtype,&datasize);

337:   /*
338:      If keys not given, assume each processor provides entire data 
339:   */
340:   if (!keys && n == key->N) {
341:     char *fdata1;
342:     if (dtype == PETSC_LOGICAL) Nb = PetscBTLength(key->N); else Nb = key->N;
343:     PetscMalloc((Nb*bs+1)*datasize,&fdata1);
344:     PetscBitMemcpy(fdata1,0,data,0,key->N*bs,dtype);
345:     segment->data = (void*)fdata1;
346:   } else if (!keys) {
347:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Keys not given, but not all data given on each processor");
348:   } else {
349:     /* transmit all lengths to all processors */
350:     MPI_Comm_size(comm,&size);
351:     PetscMalloc(2*size*sizeof(int),&lens);
352:     disp = lens + size;
353:     MPI_Allgather(&n,1,MPI_INT,lens,1,MPI_INT,comm);
354:     N =  0;
355:     for (i=0; i<size; i++) {
356:       disp[i]  = N;
357:       N       += lens[i];
358:     }
359:     if (N != key->N) {
360:       SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Did not provide correct number of keys for keyname");
361:     }

363:     /*
364:       Allocate space for all keys and all data 
365:     */
366:     PetscMalloc((N+1)*sizeof(int),&akeys);
367:     PetscMalloc((N*bs+1)*datasize,&adata);

369:     MPI_Allgatherv(keys,n,MPI_INT,akeys,lens,disp,MPI_INT,comm);
370:     for (i=0; i<size; i++) {
371:       disp[i] *= bs;
372:       lens[i] *= bs;
373:     }
374: 
375:     if (dtype != PETSC_LOGICAL) {
376:       char *fdata2;

378:       PetscDataTypeToMPIDataType(dtype,&mtype);
379:       MPI_Allgatherv(data,n*bs,mtype,adata,lens,disp,mtype,comm);
380:       PetscFree(lens);

382:       /*
383:         Now we have all the keys and data we need to put it in order
384:       */
385:       PetscMalloc((key->N+1)*sizeof(int),&fkeys);
386:       PetscMemzero(fkeys,(key->N+1)*sizeof(int));
387:       PetscMalloc((key->N*bs+1)*datasize,&fdata2);

389:       for (i=0; i<N; i++) {
390:         if (fkeys[akeys[i]] != 0) {
391:           SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Duplicate key");
392:         }
393:         if (fkeys[akeys[i]] >= N) {
394:           SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Key out of range");
395:         }
396:         fkeys[akeys[i]] = 1;
397:         PetscBitMemcpy(fdata2,akeys[i]*bs,adata,i*bs,bs,dtype);
398:       }
399:       for (i=0; i<N; i++) {
400:         if (!fkeys[i]) {
401:           SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Missing key");
402:         }
403:       }
404:       segment->data = (void*)fdata2;
405:     } else {
406:       /*
407:             For logical input the length is given by the user in bits; we need to 
408:             convert to bytes to send with MPI
409:       */
410:       PetscBT fdata3,mvalues = (PetscBT) data;
411:       char *values;
412:       PetscMalloc((n+1)*bs*sizeof(char),&values);
413:       for (i=0; i<n; i++) {
414:         for (j=0; j<bs; j++) {
415:           if (PetscBTLookup(mvalues,i*bs+j)) values[i*bs+j] = 1; else values[i*bs+j] = 0;
416:         }
417:       }

419:       MPI_Allgatherv(values,n*bs,MPI_BYTE,adata,lens,disp,MPI_BYTE,comm);
420:       PetscFree(lens);
421:       PetscFree(values);

423:       /*
424:         Now we have all the keys and data we need to put it in order
425:       */
426:       PetscMalloc((key->N+1)*sizeof(int),&fkeys);
427:       PetscMemzero(fkeys,(key->N+1)*sizeof(int));
428:       PetscBTCreate(N*bs,fdata3);

430:       for (i=0; i<N; i++) {
431:         if (fkeys[akeys[i]] != 0) {
432:           SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Duplicate key");
433:         }
434:         if (fkeys[akeys[i]] >= N) {
435:           SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Key out of range");
436:         }
437:         fkeys[akeys[i]] = 1;
438:         for (j=0; j<bs; j++) {
439:           if (adata[i*bs+j]) { PetscBTSet(fdata3,i*bs+j); }
440:         }
441:       }
442:       for (i=0; i<N; i++) {
443:         if (!fkeys[i]) {
444:           SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Missing key");
445:         }
446:       }
447:       segment->data = (void*)fdata3;
448:     }
449:     PetscFree(akeys);
450:     PetscFree(adata);
451:     PetscFree(fkeys);
452:   }

454:   key->nsegments++;

456:   PetscStrallocpy(segname,&segment->name);
457:   return(0);
458: }

460: int AODataSegmentGetExtrema_Basic(AOData ao,char *name,char *segname,void *xmax,void *xmin)
461: {
462:   AODataSegment    *segment;
463:   AODataKey        *key;
464:   int              ierr,i,bs,n,j;
465:   PetscTruth       flag;

468:   /* find the correct segment */
469:   AODataSegmentFind_Private(ao,name,segname,&flag,&key,&segment);
470:   if (!flag) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Cannot locate segment");

472:   n       = key->N;
473:   bs      = segment->bs;

475:   if (segment->datatype == PETSC_INT) {
476:     int *vmax = (int*)xmax,*vmin = (int*)xmin,*values = (int*)segment->data;
477:     for (j=0; j<bs; j++) {
478:       vmax[j] = vmin[j] = values[j];
479:     }
480:     for (i=1; i<n; i++) {
481:       for (j=0; j<bs; j++) {
482:         vmax[j] = PetscMax(vmax[j],values[bs*i+j]);
483:         vmin[j] = PetscMin(vmin[j],values[bs*i+j]);
484:       }
485:     }
486:   } else if (segment->datatype == PETSC_DOUBLE) {
487:     PetscReal *vmax = (PetscReal*)xmax,*vmin = (PetscReal*)xmin,*values = (PetscReal*)segment->data;
488:     for (j=0; j<bs; j++) {
489:       vmax[j] = vmin[j] = values[j];
490:     }
491:     for (i=1; i<n; i++) {
492:       for (j=0; j<bs; j++) {
493:         vmax[j] = PetscMax(vmax[j],values[bs*i+j]);
494:         vmin[j] = PetscMin(vmin[j],values[bs*i+j]);
495:       }
496:     }
497:   } else SETERRQ(PETSC_ERR_SUP,"Cannot find extrema for this data type");

499:   return(0);
500: }

502: int AODataSegmentGet_Basic(AOData ao,char *name,char *segname,int n,int *keys,void **data)
503: {
504:   AODataSegment    *segment;
505:   AODataKey        *key;
506:   int              ierr,dsize,i,bs,nb;
507:   char             *idata,*odata;
508:   PetscTruth       flag;
509: 
511:   /* find the correct segment */
512:   AODataSegmentFind_Private(ao,name,segname,&flag,&key,&segment);
513:   if (!flag) SETERRQ2(PETSC_ERR_ARG_WRONG,"Cannot locate segment %s in key %s",segname,name);

515:   ierr  = PetscDataTypeGetSize(segment->datatype,&dsize);
516:   bs    = segment->bs;
517:   if (segment->datatype == PETSC_LOGICAL) nb = PetscBTLength(n); else nb = n;
518:   PetscMalloc((nb+1)*bs*dsize,&odata);
519:   idata = (char*)segment->data;
520:   for (i=0; i<n; i++) {
521:     PetscBitMemcpy(odata,i*bs,idata,keys[i]*bs,bs,segment->datatype);
522:   }
523:   *data = (void*)odata;
524:   return(0);
525: }

527: int AODataSegmentRestore_Basic(AOData aodata,char *name,char *segname,int n,int *keys,void **data)
528: {

532:   PetscFree(*data);
533:   return(0);
534: }

536: int AODataSegmentGetLocal_Basic(AOData ao,char *name,char *segname,int n,int *keys,void **data)
537: {
538:   int           ierr,*globals,*locals,bs;
539:   PetscDataType dtype;
540:   AODataKey     *key;
541:   PetscTruth    flag;

544:   AODataKeyFind_Private(ao,segname,&flag,&key);
545:   if (!flag) SETERRQ(PETSC_ERR_ARG_WRONG,"Segment does not have corresponding key");
546:   if (!key->ltog) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"No local to global mapping set for key");
547:   AODataSegmentGetInfo(ao,name,segname,&bs,&dtype);
548:   if (dtype != PETSC_INT) SETERRQ(PETSC_ERR_ARG_WRONG,"Datatype of segment must be PETSC_INT");

550:   /* get the values in global indexing */
551:   AODataSegmentGet_Basic(ao,name,segname,n,keys,(void **)&globals);
552: 
553:   /* allocate space to store them in local indexing */
554:   PetscMalloc((n+1)*bs*sizeof(int),&locals);

556:   ISGlobalToLocalMappingApply(key->ltog,IS_GTOLM_MASK,n*bs,globals,PETSC_NULL,locals);

558:   AODataSegmentRestore_Basic(ao,name,segname,n,keys,(void **)&globals);

560:   *data = (void*)locals;
561:   return(0);
562: }

564: int AODataSegmentRestoreLocal_Basic(AOData aodata,char *name,char *segname,int n,int *keys,void **data)
565: {

569:   PetscFree(*data);
570:   return(0);
571: }

573: EXTERN int AOBasicGetIndices_Private(AO,int **,int **);

575: int AODataKeyRemap_Basic(AOData aodata,char *keyname,AO ao)
576: {
577:   int           ierr,*inew,k,*ii,nk,dsize,bs,nkb;
578:   char          *data,*tmpdata;
579:   AODataKey     *key;
580:   AODataSegment *seg;
581:   PetscTruth    flag,match;


585:   /* remap all the values in the segments that match the key */
586:   key = aodata->keys;
587:   while (key) {
588:     seg = key->segments;
589:     while (seg) {
590:       PetscStrcmp(seg->name,keyname,&match);
591:       if (!match) {
592:         seg = seg->next;
593:         continue;
594:       }
595:       if (seg->datatype != PETSC_INT) {
596:         SETERRQ(PETSC_ERR_ARG_WRONG,"Segment name same as key but not integer type");
597:       }
598:       nk   = seg->bs*key->N;
599:       ii   = (int*)seg->data;
600:       AOPetscToApplication(ao,nk,ii);
601:       seg  = seg->next;
602:     }
603:     key = key->next;
604:   }
605: 
606:   AOBasicGetIndices_Private(ao,&inew,PETSC_NULL);
607:   /* reorder in the arrays all the values for the key */
608:   AODataKeyFind_Private(aodata,keyname,&flag,&key);
609:   if (!flag) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Could not find key");
610:   nk  = key->N;
611:   seg = key->segments;
612:   while (seg) {
613:     ierr    = PetscDataTypeGetSize(seg->datatype,&dsize);
614:     bs      = seg->bs;
615:     data    = (char*)seg->data;
616:     if (seg->datatype == PETSC_LOGICAL) nkb = PetscBTLength(nk*bs); else nkb = nk*bs;
617:     PetscMalloc((nkb+1)*dsize,&tmpdata);

619:     for (k=0; k<nk; k++) {
620:       PetscBitMemcpy(tmpdata,inew[k]*bs,data,k*bs,bs,seg->datatype);
621:     }
622:     PetscMemcpy(data,tmpdata,nkb*dsize);
623:     PetscFree(tmpdata);
624:     seg = seg->next;
625:   }

627:   return(0);
628: }

630: int AODataKeyGetAdjacency_Basic(AOData aodata,char *keyname,Mat *adj)
631: {
632:   int           ierr,cnt,i,j,*jj,*ii,nlocal,n,*nb,bs,ls;
633:   AODataKey     *key;
634:   AODataSegment *seg;
635:   PetscTruth    flag;

638:   AODataSegmentFind_Private(aodata,keyname,keyname,&flag,&key,&seg);
639:   if (!flag) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Cannot locate key with neighbor segment");

641:   /*
642:      Get the beginning of the neighbor list for this processor 
643:   */
644:   bs     = seg->bs;
645:   nb     = (int*)seg->data;
646:   nb    += bs*key->rstart;
647:   nlocal = key->rend - key->rstart;
648:   n      = bs*key->N;

650:   /*
651:       Assemble the adjacency graph: first we determine total number of entries
652:   */
653:   cnt = 0;
654:   for (i=0; i<bs*nlocal; i++) {
655:     if (nb[i] >= 0) cnt++;
656:   }
657:   PetscMalloc((nlocal + 1)*sizeof(int),&ii);
658:   PetscMalloc((cnt+1)*sizeof(int),&jj);
659:   ii[0] = 0;
660:   cnt   = 0;
661:   for (i=0; i<nlocal; i++) {
662:     ls = 0;
663:     for (j=0; j<bs; j++) {
664:       if (nb[bs*i+j] >= 0) {
665:         jj[cnt++] = nb[bs*i+j];
666:         ls++;
667:       }
668:     }
669:     /* now sort the column indices for this row */
670:     PetscSortInt(ls,jj+cnt-ls);
671:     ii[i+1] = cnt;
672:   }

674:   MatCreateMPIAdj(aodata->comm,nlocal,n,ii,jj,PETSC_NULL,adj);
675:   return(0);
676: }

678: int AODataSegmentPartition_Basic(AOData aodata,char *keyname,char *segname)
679: {
680:   int             ierr,size,bs,i,j,*idx,nc,*isc;
681:   AO              ao;
682:   AODataKey       *key,*keyseg;
683:   AODataSegment   *segment;
684:   PetscTruth      flag;


688:   AODataKeyFind_Private(aodata,segname,&flag,&keyseg);
689:   if (!flag) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Cannot locate segment as a key");
690:   PetscMalloc(keyseg->N*sizeof(int),&isc);
691:   PetscMemzero(isc,keyseg->N*sizeof(int));

693:   AODataSegmentFind_Private(aodata,keyname,segname,&flag,&key,&segment);
694:   if (flag != 1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Cannot locate segment");
695:   MPI_Comm_size(aodata->comm,&size);

697:   bs                = segment->bs;

699:   idx = (int*)segment->data;
700:   nc  = 0;
701:   for (i=0; i<size; i++) {
702:     for (j=bs*key->rowners[i]; j<bs*key->rowners[i+1]; j++) {
703:       if (!isc[idx[j]]) {
704:         isc[idx[j]] = ++nc;
705:       }
706:     }
707:   }
708:   for (i=0; i<keyseg->N; i++) {
709:     isc[i]--;
710:   }

712:   AOCreateBasic(aodata->comm,keyseg->nlocal,isc+keyseg->rstart,PETSC_NULL,&ao);
713:   PetscFree(isc);

715:   AODataKeyRemap(aodata,segname,ao);
716:   AODestroy(ao);
717:   return(0);
718: }

720: int AODataKeyGetActive_Basic(AOData aodata,char *name,char *segname,int n,int *keys,int wl,IS *is)
721: {
722:   int           ierr,i,cnt,*fnd,bs;
723:   AODataKey     *key;
724:   AODataSegment *segment;
725:   PetscBT       bt;
726:   PetscTruth    flag;

729:   AODataSegmentFind_Private(aodata,name,segname,&flag,&key,&segment);
730:   if (!flag) SETERRQ(1,"Cannot locate segment");

732:   bt = (PetscBT) segment->data;
733:   bs = segment->bs;

735:   if (wl >= bs) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Bit field (wl) argument too large");

737:   /* count the active ones */
738:   cnt = 0;
739:   for (i=0; i<n; i++) {
740:     if (PetscBTLookup(bt,keys[i]*bs+wl)) {
741:       cnt++;
742:     }
743:   }

745:   PetscMalloc((cnt+1)*sizeof(int),&fnd);
746:   cnt = 0;
747:   for (i=0; i<n; i++) {
748:     if (PetscBTLookup(bt,keys[i]*bs+wl)) {
749:       fnd[cnt++] = keys[i];
750:     }
751:   }
752: 
753:   ISCreateGeneral(aodata->comm,cnt,fnd,is);
754:   PetscFree(fnd);
755:   return(0);
756: }

758: int AODataKeyGetActiveLocal_Basic(AOData aodata,char *name,char *segname,int n,int *keys,int wl,IS *is)
759: {
760:   int           ierr,i,cnt,*fnd,bs,*locals;
761:   AODataKey     *key;
762:   AODataSegment *segment;
763:   PetscBT       bt;
764:   PetscTruth    flag;

767:   AODataSegmentFind_Private(aodata,name,segname,&flag,&key,&segment);
768:   if (!flag) SETERRQ(1,"Cannot locate segment");

770:   bt = (PetscBT) segment->data;
771:   bs = segment->bs;

773:   if (wl >= bs) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Bit field (wl) argument too large");

775:   /* count the active ones */
776:   cnt = 0;
777:   for (i=0; i<n; i++) {
778:     if (PetscBTLookup(bt,keys[i]*bs+wl)) {
779:       cnt++;
780:     }
781:   }

783:   PetscMalloc((cnt+1)*sizeof(int),&fnd);
784:   cnt = 0;
785:   for (i=0; i<n; i++) {
786:     if (PetscBTLookup(bt,keys[i]*bs+wl)) {
787:       fnd[cnt++] = keys[i];
788:     }
789:   }
790: 
791:   PetscMalloc((n+1)*sizeof(int),&locals);
792:   ISGlobalToLocalMappingApply(key->ltog,IS_GTOLM_MASK,cnt,fnd,PETSC_NULL,locals);
793:   PetscFree(fnd);
794:   ISCreateGeneral(aodata->comm,cnt,locals,is);
795:   PetscFree(locals);
796:   return(0);
797: }

799: EXTERN int AODataSegmentGetReduced_Basic(AOData,char *,char *,int,int*,IS *);
800: EXTERN int AODataPublish_Petsc(PetscObject);

802: static struct _AODataOps myops = {AODataSegmentAdd_Basic,
803:                                   AODataSegmentGet_Basic,
804:                                   AODataSegmentRestore_Basic,
805:                                   AODataSegmentGetLocal_Basic,
806:                                   AODataSegmentRestoreLocal_Basic,
807:                                   AODataSegmentGetReduced_Basic,
808:                                   AODataSegmentGetExtrema_Basic,
809:                                   AODataKeyRemap_Basic,
810:                                   AODataKeyGetAdjacency_Basic,
811:                                   AODataKeyGetActive_Basic,
812:                                   AODataKeyGetActiveLocal_Basic,
813:                                   AODataSegmentPartition_Basic,
814:                                   AODataKeyRemove_Basic,
815:                                   AODataSegmentRemove_Basic,
816:                                   AODataDestroy_Basic,
817:                                   AODataView_Basic};

819: /*@C
820:    AODataCreateBasic - Creates an AO datastructure.

822:    Collective on MPI_Comm

824:    Input Parameters:
825: +  comm  - MPI communicator that is to share AO
826: -  n - total number of keys that will be added

828:    Output Parameter:
829: .  aoout - the new database

831:    Options Database Keys:
832: +  -ao_data_view - Prints entire database at the conclusion of AODataSegmentAdd()
833: -  -ao_data_view_info - Prints info about database at the conclusion of AODataSegmentAdd()

835:    Level: intermediate

837: .keywords: AOData, create

839: .seealso: AODataSegmentAdd(), AODataDestroy()
840: @*/
841: int AODataCreateBasic(MPI_Comm comm,AOData *aoout)
842: {
843:   AOData    ao;
844:   int       ierr;

848:   *aoout = 0;
849: #ifndef PETSC_USE_DYNAMIC_LIBRARIES
850:   DMInitializePackage(PETSC_NULL);
851: #endif

853:   PetscHeaderCreate(ao,_p_AOData,struct _AODataOps,AODATA_COOKIE,AODATA_BASIC,"AOData",comm,AODataDestroy,AODataView);
854:   PetscLogObjectCreate(ao);
855:   PetscLogObjectMemory(ao,sizeof(struct _p_AOData));

857:   PetscMemcpy(ao->ops,&myops,sizeof(myops));
858:   ao->bops->publish = AODataPublish_Petsc;

860:   ao->nkeys        = 0;
861:   ao->keys         = 0;
862:   ao->datacomplete = 0;

864:   PetscPublishAll(ao);
865:   *aoout = ao;
866:   return(0);
867: }

869: /*@C
870:    AODataLoadBasic - Loads an AO database from a file.

872:    Collective on PetscViewer

874:    Input Parameters:
875: .  viewer - the binary file containing the data

877:    Output Parameter:
878: .  aoout - the new database

880:    Options Database Keys:
881: +  -ao_data_view - Prints entire database at the conclusion of AODataLoadBasic()
882: -  -ao_data_view_info - Prints info about database at the conclusion of AODataLoadBasic()

884:    Level: intermediate

886: .keywords: AOData, create, load, basic

888: .seealso: AODataSegmentAdd(), AODataDestroy(), AODataCreateBasic(), AODataView() 
889: @*/
890: int AODataLoadBasic(PetscViewer viewer,AOData *aoout)
891: {
892:   AOData        ao;
893:   int           fd,nkeys,i,ierr,dsize,j,size,rank,Nb;
894:   char          paddedname[256];
895:   AODataSegment *seg = 0;
896:   AODataKey     *key = 0;
897:   MPI_Comm      comm;
898:   PetscTruth    isbinary,flg1;

901:   *aoout = 0;
902:   PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_BINARY,&isbinary);
903:   if (!isbinary) {
904:     SETERRQ(PETSC_ERR_ARG_WRONG,"Viewer must be obtained from PetscViewerBinaryOpen()");
905:   }

907:   PetscObjectGetComm((PetscObject)viewer,&comm);
908:   MPI_Comm_size(comm,&size);
909:   MPI_Comm_rank(comm,&rank);

911:   PetscViewerBinaryGetDescriptor(viewer,&fd);

913:   /* read in number of segments */
914:   PetscBinaryRead(fd,&nkeys,1,PETSC_INT);

916:   PetscHeaderCreate(ao,_p_AOData,struct _AODataOps,AODATA_COOKIE,AODATA_BASIC,"AOData",comm,AODataDestroy,AODataView);
917:   PetscLogObjectCreate(ao);
918:   PetscLogObjectMemory(ao,sizeof(struct _p_AOData) + nkeys*sizeof(void *));

920:   PetscMemcpy(ao->ops,&myops,sizeof(myops));
921:   ao->bops->publish  = AODataPublish_Petsc;

923:   ao->nkeys      = nkeys;

925:   for (i=0; i<nkeys; i++) {
926:     if (!i) {
927:       ierr     = PetscNew(AODataKey,&key);
928:       ao->keys = key;
929:     } else {
930:       PetscNew(AODataKey,&key->next);
931:       key  = key->next;
932:     }
933:     key->ltog = 0;
934:     key->next = 0;

936:     /* read in key name */
937:     PetscBinaryRead(fd,paddedname,256,PETSC_CHAR);
938:     PetscStrallocpy(paddedname,&key->name);
939:     PetscBinaryRead(fd,&key->N,1,PETSC_INT);

941:     /* determine Nlocal and rowners for key */
942:     key->nlocal  = key->N/size + ((key->N % size) > rank);
943:     PetscMalloc((size+1)*sizeof(int),&key->rowners);
944:     MPI_Allgather(&key->nlocal,1,MPI_INT,key->rowners+1,1,MPI_INT,comm);
945:     key->rowners[0] = 0;
946:     for (j=2; j<=size; j++) {
947:       key->rowners[j] += key->rowners[j-1];
948:     }
949:     key->rstart        = key->rowners[rank];
950:     key->rend          = key->rowners[rank+1];

952:     /* loop key's segments, reading them in */
953:     PetscBinaryRead(fd,&key->nsegments,1,PETSC_INT);

955:     for (j=0; j<key->nsegments; j++) {
956:       if (!j) {
957:         ierr          = PetscNew(AODataSegment,&seg);
958:         key->segments = seg;
959:       } else {
960:         PetscNew(AODataSegment,&seg->next);
961:         seg  = seg->next;
962:       }

964:       /* read in segment name */
965:       PetscBinaryRead(fd,paddedname,256,PETSC_CHAR);
966:       PetscStrallocpy(paddedname,&seg->name);

968:       /* read in segment blocksize and datatype */
969:       PetscBinaryRead(fd,&seg->bs,1,PETSC_INT);
970:       PetscBinaryRead(fd,&seg->datatype,1,PETSC_INT);

972:       /* allocate the space for the data */
973:       PetscDataTypeGetSize(seg->datatype,&dsize);
974:       if (seg->datatype == PETSC_LOGICAL) Nb = PetscBTLength(key->N*seg->bs); else Nb = key->N*seg->bs;
975:       PetscMalloc(Nb*dsize,&seg->data);
976:       /* read in the data */
977:       PetscBinaryRead(fd,seg->data,key->N*seg->bs,seg->datatype);
978:       seg->next = 0;
979:     }
980:   }
981:   *aoout = ao;

983:   PetscOptionsHasName(PETSC_NULL,"-ao_data_view",&flg1);
984:   if (flg1) {
985:     AODataView(ao,PETSC_VIEWER_STDOUT_(comm));
986:   }
987:   PetscOptionsHasName(PETSC_NULL,"-ao_data_view_info",&flg1);
988:   if (flg1) {
989:     PetscViewerPushFormat(PETSC_VIEWER_STDOUT_(comm),PETSC_VIEWER_ASCII_INFO);
990:     AODataView(ao,PETSC_VIEWER_STDOUT_(comm));
991:     PetscViewerPopFormat(PETSC_VIEWER_STDOUT_(comm));
992:   }
993:   PetscPublishAll(ao);
994:   return(0);
995: }