xref: /petsc/src/dm/impls/swarm/data_bucket.c (revision 3d96e9964ff330fd2a9eee374bcd4376da7efe60)
1 
2 #include "data_bucket.h"
3 
4 /* string helpers */
5 PetscErrorCode StringInList(const char name[],const PetscInt N,const DataField gfield[],PetscBool *val)
6 {
7   PetscInt       i;
8   PetscErrorCode ierr;
9 
10   PetscFunctionBegin;
11   *val = PETSC_FALSE;
12   for (i = 0; i < N; ++i) {
13     PetscBool flg;
14     ierr = PetscStrcmp(name, gfield[i]->name, &flg);CHKERRQ(ierr);
15     if (flg) {
16       *val = PETSC_TRUE;
17       PetscFunctionReturn(0);
18     }
19   }
20   PetscFunctionReturn(0);
21 }
22 
23 PetscErrorCode StringFindInList(const char name[],const PetscInt N,const DataField gfield[],PetscInt *index)
24 {
25   PetscInt       i;
26   PetscErrorCode ierr;
27 
28   PetscFunctionBegin;
29   *index = -1;
30   for (i = 0; i < N; ++i) {
31     PetscBool flg;
32     ierr = PetscStrcmp(name, gfield[i]->name, &flg);CHKERRQ(ierr);
33     if (flg) {
34       *index = i;
35       PetscFunctionReturn(0);
36     }
37   }
38   PetscFunctionReturn(0);
39 }
40 
41 PetscErrorCode DataFieldCreate(const char registeration_function[],const char name[],const size_t size,const PetscInt L,DataField *DF)
42 {
43   DataField      df;
44   PetscErrorCode ierr;
45 
46   PetscFunctionBegin;
47   ierr = PetscMalloc(sizeof(struct _p_DataField), &df);CHKERRQ(ierr);
48   ierr = PetscMemzero(df, sizeof(struct _p_DataField));CHKERRQ(ierr);
49   ierr = PetscStrallocpy(registeration_function, &df->registeration_function);CHKERRQ(ierr);
50   ierr = PetscStrallocpy(name, &df->name);CHKERRQ(ierr);
51   df->atomic_size = size;
52   df->L  = L;
53   df->bs = 1;
54   /* allocate something so we don't have to reallocate */
55   ierr = PetscMalloc(size * L, &df->data);CHKERRQ(ierr);
56   ierr = PetscMemzero(df->data, size * L);CHKERRQ(ierr);
57   *DF = df;
58   PetscFunctionReturn(0);
59 }
60 
61 PetscErrorCode DataFieldDestroy(DataField *DF)
62 {
63   DataField      df = *DF;
64   PetscErrorCode ierr;
65 
66   PetscFunctionBegin;
67   ierr = PetscFree(df->registeration_function);CHKERRQ(ierr);
68   ierr = PetscFree(df->name);CHKERRQ(ierr);
69   ierr = PetscFree(df->data);CHKERRQ(ierr);
70   ierr = PetscFree(df);CHKERRQ(ierr);
71   *DF  = NULL;
72   PetscFunctionReturn(0);
73 }
74 
75 /* data bucket */
76 PetscErrorCode DataBucketCreate(DataBucket *DB)
77 {
78   DataBucket     db;
79   PetscErrorCode ierr;
80 
81   PetscFunctionBegin;
82   ierr = PetscMalloc(sizeof(struct _p_DataBucket), &db);CHKERRQ(ierr);
83   ierr = PetscMemzero(db, sizeof(struct _p_DataBucket));CHKERRQ(ierr);
84 
85   db->finalised = PETSC_FALSE;
86   /* create empty spaces for fields */
87   db->L         = -1;
88   db->buffer    = 1;
89   db->allocated = 1;
90   db->nfields   = 0;
91   ierr = PetscMalloc1(1, &db->field);CHKERRQ(ierr);
92   *DB  = db;
93   PetscFunctionReturn(0);
94 }
95 
96 PetscErrorCode DataBucketDestroy(DataBucket *DB)
97 {
98   DataBucket     db = *DB;
99   PetscInt       f;
100   PetscErrorCode ierr;
101 
102   PetscFunctionBegin;
103   /* release fields */
104   for (f = 0; f < db->nfields; ++f) {
105     ierr = DataFieldDestroy(&db->field[f]);CHKERRQ(ierr);
106   }
107   /* this will catch the initially allocated objects in the event that no fields are registered */
108   if (db->field != NULL) {
109     ierr = PetscFree(db->field);CHKERRQ(ierr);
110   }
111   ierr = PetscFree(db);CHKERRQ(ierr);
112   *DB = NULL;
113   PetscFunctionReturn(0);
114 }
115 
116 PetscErrorCode DataBucketQueryForActiveFields(DataBucket db,PetscBool *any_active_fields)
117 {
118   PetscInt f;
119 
120   PetscFunctionBegin;
121   *any_active_fields = PETSC_FALSE;
122   for (f = 0; f < db->nfields; ++f) {
123     if (db->field[f]->active) {
124       *any_active_fields = PETSC_TRUE;
125       PetscFunctionReturn(0);
126     }
127   }
128   PetscFunctionReturn(0);
129 }
130 
131 PetscErrorCode DataBucketRegisterField(
132                               DataBucket db,
133                               const char registeration_function[],
134                               const char field_name[],
135                               size_t atomic_size, DataField *_gfield)
136 {
137   PetscBool val;
138   DataField fp;
139   PetscErrorCode ierr;
140 
141   PetscFunctionBegin;
142 	/* check we haven't finalised the registration of fields */
143 	/*
144    if(db->finalised==PETSC_TRUE) {
145    printf("ERROR: DataBucketFinalize() has been called. Cannot register more fields\n");
146    ERROR();
147    }
148    */
149   /* check for repeated name */
150   ierr = StringInList(field_name, db->nfields, (const DataField*) db->field, &val);CHKERRQ(ierr);
151   if (val == PETSC_TRUE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Field %s already exists. Cannot add same field twice",field_name);
152   /* create new space for data */
153   ierr = PetscRealloc(sizeof(DataField)*(db->nfields+1), &db->field);CHKERRQ(ierr);
154   /* add field */
155   ierr = DataFieldCreate(registeration_function, field_name, atomic_size, db->allocated, &fp);CHKERRQ(ierr);
156   db->field[db->nfields] = fp;
157   db->nfields++;
158   if (_gfield != NULL) {
159     *_gfield = fp;
160   }
161   PetscFunctionReturn(0);
162 }
163 
164 /*
165  #define DataBucketRegisterField(db,name,size,k) {\
166  char *location;\
167  asprintf(&location,"Registered by %s() at line %d within file %s", __FUNCTION__, __LINE__, __FILE__);\
168  _DataBucketRegisterField( (db), location, (name), (size), (k) );\
169  ierr = PetscFree(location);\
170  }
171  */
172 
173 PetscErrorCode DataBucketGetDataFieldByName(DataBucket db,const char name[],DataField *gfield)
174 {
175   PetscInt       idx;
176   PetscBool      found;
177   PetscErrorCode ierr;
178 
179   PetscFunctionBegin;
180   ierr = StringInList(name,db->nfields,(const DataField*)db->field,&found);CHKERRQ(ierr);
181   if (!found) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Cannot find DataField with name %s",name);
182   ierr = StringFindInList(name,db->nfields,(const DataField*)db->field,&idx);CHKERRQ(ierr);
183   *gfield = db->field[idx];
184   PetscFunctionReturn(0);
185 }
186 
187 PetscErrorCode DataBucketQueryDataFieldByName(DataBucket db,const char name[],PetscBool *found)
188 {
189   PetscErrorCode ierr;
190 
191   PetscFunctionBegin;
192   *found = PETSC_FALSE;
193   ierr = StringInList(name,db->nfields,(const DataField*)db->field,found);CHKERRQ(ierr);
194   PetscFunctionReturn(0);
195 }
196 
197 PetscErrorCode DataBucketFinalize(DataBucket db)
198 {
199   PetscFunctionBegin;
200   db->finalised = PETSC_TRUE;
201   PetscFunctionReturn(0);
202 }
203 
204 PetscErrorCode DataFieldGetNumEntries(DataField df,PetscInt *sum)
205 {
206   PetscFunctionBegin;
207   *sum = df->L;
208   PetscFunctionReturn(0);
209 }
210 
211 PetscErrorCode DataFieldSetBlockSize(DataField df,PetscInt blocksize)
212 {
213   PetscFunctionBegin;
214   df->bs = blocksize;
215   PetscFunctionReturn(0);
216 }
217 
218 PetscErrorCode DataFieldSetSize(DataField df,const PetscInt new_L)
219 {
220   PetscErrorCode ierr;
221 
222   PetscFunctionBegin;
223   if (new_L < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Cannot set size of DataField to be < 0");
224   if (new_L == df->L) PetscFunctionReturn(0);
225   if (new_L > df->L) {
226     ierr = PetscRealloc(df->atomic_size * (new_L), &df->data);CHKERRQ(ierr);
227     /* init new contents */
228     ierr = PetscMemzero(( ((char*)df->data)+df->L*df->atomic_size), (new_L-df->L)*df->atomic_size);CHKERRQ(ierr);
229   } else {
230     /* reallocate pointer list, add +1 in case new_L = 0 */
231     ierr = PetscRealloc(df->atomic_size * (new_L+1), &df->data);CHKERRQ(ierr);
232   }
233   df->L = new_L;
234   PetscFunctionReturn(0);
235 }
236 
237 PetscErrorCode DataFieldZeroBlock(DataField df,const PetscInt start,const PetscInt end)
238 {
239   PetscErrorCode ierr;
240 
241   PetscFunctionBegin;
242   if (start > end) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Cannot zero a block of entries if start(%D) > end(%D)",start,end);
243   if (start < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Cannot zero a block of entries if start(%D) < 0",start);
244   if (end > df->L) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Cannot zero a block of entries if end(%D) >= array size(%D)",end,df->L);
245   ierr = PetscMemzero((((char*)df->data)+start*df->atomic_size), (end-start)*df->atomic_size);CHKERRQ(ierr);
246   PetscFunctionReturn(0);
247 }
248 
249 /*
250  A negative buffer value will simply be ignored and the old buffer value will be used.
251  */
252 PetscErrorCode DataBucketSetSizes(DataBucket db,const PetscInt L,const PetscInt buffer)
253 {
254   PetscInt       current_allocated,new_used,new_unused,new_buffer,new_allocated,f;
255   PetscBool      any_active_fields;
256   PetscErrorCode ierr;
257 
258   PetscFunctionBegin;
259   if (db->finalised == PETSC_FALSE) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"You must call DataBucketFinalize() before DataBucketSetSizes()");
260   ierr = DataBucketQueryForActiveFields(db,&any_active_fields);CHKERRQ(ierr);
261   if (any_active_fields) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Cannot safely re-size as at least one DataField is currently being accessed");
262 
263   current_allocated = db->allocated;
264   new_used   = L;
265   new_unused = current_allocated - new_used;
266   new_buffer = db->buffer;
267   if (buffer >= 0) { /* update the buffer value */
268     new_buffer = buffer;
269   }
270   new_allocated = new_used + new_buffer;
271   /* action */
272   if (new_allocated > current_allocated) {
273     /* increase size to new_used + new_buffer */
274     for (f=0; f<db->nfields; f++) {
275       ierr = DataFieldSetSize(db->field[f], new_allocated);CHKERRQ(ierr);
276     }
277     db->L         = new_used;
278     db->buffer    = new_buffer;
279     db->allocated = new_used + new_buffer;
280   } else {
281     if (new_unused > 2 * new_buffer) {
282       /* shrink array to new_used + new_buffer */
283       for (f = 0; f < db->nfields; ++f) {
284         ierr = DataFieldSetSize(db->field[f], new_allocated);CHKERRQ(ierr);
285       }
286       db->L         = new_used;
287       db->buffer    = new_buffer;
288       db->allocated = new_used + new_buffer;
289     } else {
290       db->L      = new_used;
291       db->buffer = new_buffer;
292     }
293   }
294   /* zero all entries from db->L to db->allocated */
295   for (f = 0; f < db->nfields; ++f) {
296     DataField field = db->field[f];
297     ierr = DataFieldZeroBlock(field, db->L,db->allocated);CHKERRQ(ierr);
298   }
299   PetscFunctionReturn(0);
300 }
301 
302 PetscErrorCode DataBucketSetInitialSizes(DataBucket db,const PetscInt L,const PetscInt buffer)
303 {
304   PetscInt       f;
305   PetscErrorCode ierr;
306 
307   PetscFunctionBegin;
308   ierr = DataBucketSetSizes(db,L,buffer);CHKERRQ(ierr);
309   for (f = 0; f < db->nfields; ++f) {
310     DataField field = db->field[f];
311     ierr = DataFieldZeroBlock(field,0,db->allocated);CHKERRQ(ierr);
312   }
313   PetscFunctionReturn(0);
314 }
315 
316 PetscErrorCode DataBucketGetSizes(DataBucket db,PetscInt *L,PetscInt *buffer,PetscInt *allocated)
317 {
318   PetscFunctionBegin;
319   if (L) {*L = db->L;}
320   if (buffer) {*buffer = db->buffer;}
321   if (allocated) {*allocated = db->allocated;}
322   PetscFunctionReturn(0);
323 }
324 
325 PetscErrorCode DataBucketGetGlobalSizes(MPI_Comm comm,DataBucket db,PetscInt *L,PetscInt *buffer,PetscInt *allocated)
326 {
327   PetscInt _L,_buffer,_allocated;
328   PetscInt ierr;
329 
330   PetscFunctionBegin;
331   _L = db->L;
332   _buffer = db->buffer;
333   _allocated = db->allocated;
334 
335   if (L) {         ierr = MPI_Allreduce(&_L,L,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr); }
336   if (buffer) {    ierr = MPI_Allreduce(&_buffer,buffer,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr); }
337   if (allocated) { ierr = MPI_Allreduce(&_allocated,allocated,1,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr); }
338   PetscFunctionReturn(0);
339 }
340 
341 PetscErrorCode DataBucketGetDataFields(DataBucket db,PetscInt *L,DataField *fields[])
342 {
343   PetscFunctionBegin;
344   if (L)      {*L      = db->nfields;}
345   if (fields) {*fields = db->field;}
346   PetscFunctionReturn(0);
347 }
348 
349 PetscErrorCode DataFieldGetAccess(const DataField gfield)
350 {
351   PetscFunctionBegin;
352   if (gfield->active) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Field \"%s\" is already active. You must call DataFieldRestoreAccess()",gfield->name);
353   gfield->active = PETSC_TRUE;
354   PetscFunctionReturn(0);
355 }
356 
357 PetscErrorCode DataFieldAccessPoint(const DataField gfield,const PetscInt pid,void **ctx_p)
358 {
359   PetscFunctionBegin;
360   *ctx_p = NULL;
361 #ifdef DATAFIELD_POINT_ACCESS_GUARD
362   /* debug mode */
363   /* check point is valid */
364   if (pid < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be >= 0");
365   if (pid >= gfield->L) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be < %D",gfield->L);
366   if (gfield->active == PETSC_FALSE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Field \"%s\" is not active. You must call DataFieldGetAccess() before point data can be retrivied",gfield->name);
367 #endif
368   *ctx_p = __DATATFIELD_point_access(gfield->data,pid,gfield->atomic_size);
369   PetscFunctionReturn(0);
370 }
371 
372 PetscErrorCode DataFieldAccessPointOffset(const DataField gfield,const size_t offset,const PetscInt pid,void **ctx_p)
373 {
374   PetscFunctionBegin;
375 #ifdef DATAFIELD_POINT_ACCESS_GUARD
376   /* debug mode */
377   /* check point is valid */
378   /* if( offset < 0 ) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"offset must be >= 0");*/
379   /* Note compiler realizes this can never happen with an unsigned PetscInt */
380   if (offset >= gfield->atomic_size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"offset must be < %zu",gfield->atomic_size);
381   /* check point is valid */
382   if (pid < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be >= 0");
383   if (pid >= gfield->L) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be < %D",gfield->L);
384   if (gfield->active == PETSC_FALSE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Field \"%s\" is not active. You must call DataFieldGetAccess() before point data can be retrivied",gfield->name);
385 #endif
386   *ctx_p = __DATATFIELD_point_access_offset(gfield->data,pid,gfield->atomic_size,offset);
387   PetscFunctionReturn(0);
388 }
389 
390 PetscErrorCode DataFieldRestoreAccess(DataField gfield)
391 {
392   PetscFunctionBegin;
393   if (gfield->active == PETSC_FALSE) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"Field \"%s\" is not active. You must call DataFieldGetAccess()", gfield->name);
394   gfield->active = PETSC_FALSE;
395   PetscFunctionReturn(0);
396 }
397 
398 PetscErrorCode DataFieldVerifyAccess(const DataField gfield,const size_t size)
399 {
400   PetscFunctionBegin;
401 #ifdef DATAFIELD_POINT_ACCESS_GUARD
402   if (gfield->atomic_size != size) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_USER,"Field \"%s\" must be mapped to %zu bytes, your intended structure is %zu bytes in length.",gfield->name, gfield->atomic_size, size );
403 #endif
404   PetscFunctionReturn(0);
405 }
406 
407 PetscErrorCode DataFieldGetAtomicSize(const DataField gfield,size_t *size)
408 {
409   PetscFunctionBegin;
410   if (size) {*size = gfield->atomic_size;}
411   PetscFunctionReturn(0);
412 }
413 
414 PetscErrorCode DataFieldGetEntries(const DataField gfield,void **data)
415 {
416   PetscFunctionBegin;
417   if (data) {*data = gfield->data;}
418   PetscFunctionReturn(0);
419 }
420 
421 PetscErrorCode DataFieldRestoreEntries(const DataField gfield,void **data)
422 {
423   PetscFunctionBegin;
424   if (data) {*data = NULL;}
425   PetscFunctionReturn(0);
426 }
427 
428 /* y = x */
429 PetscErrorCode DataBucketCopyPoint(const DataBucket xb,const PetscInt pid_x,
430                          const DataBucket yb,const PetscInt pid_y)
431 {
432   PetscInt f;
433   PetscErrorCode ierr;
434 
435   PetscFunctionBegin;
436   for (f = 0; f < xb->nfields; ++f) {
437     void *dest;
438     void *src;
439 
440     ierr = DataFieldGetAccess(xb->field[f]);CHKERRQ(ierr);
441     if (xb != yb) { ierr = DataFieldGetAccess( yb->field[f]);CHKERRQ(ierr); }
442     ierr = DataFieldAccessPoint(xb->field[f],pid_x, &src);CHKERRQ(ierr);
443     ierr = DataFieldAccessPoint(yb->field[f],pid_y, &dest);CHKERRQ(ierr);
444     ierr = PetscMemcpy(dest, src, xb->field[f]->atomic_size);CHKERRQ(ierr);
445     ierr = DataFieldRestoreAccess(xb->field[f]);CHKERRQ(ierr);
446     if (xb != yb) {ierr = DataFieldRestoreAccess(yb->field[f]);CHKERRQ(ierr);}
447   }
448   PetscFunctionReturn(0);
449 }
450 
451 PetscErrorCode DataBucketCreateFromSubset(DataBucket DBIn,const PetscInt N,const PetscInt list[],DataBucket *DB)
452 {
453   PetscInt nfields;
454   DataField *fields;
455   PetscInt f,L,buffer,allocated,p;
456   PetscErrorCode ierr;
457 
458   PetscFunctionBegin;
459   ierr = DataBucketCreate(DB);CHKERRQ(ierr);
460   /* copy contents of DBIn */
461   ierr = DataBucketGetDataFields(DBIn,&nfields,&fields);CHKERRQ(ierr);
462   ierr = DataBucketGetSizes(DBIn,&L,&buffer,&allocated);CHKERRQ(ierr);
463   for (f = 0; f < nfields; ++f) {
464     ierr = DataBucketRegisterField(*DB,"DataBucketCreateFromSubset",fields[f]->name,fields[f]->atomic_size,NULL);CHKERRQ(ierr);
465   }
466   ierr = DataBucketFinalize(*DB);CHKERRQ(ierr);
467   ierr = DataBucketSetSizes(*DB,L,buffer);CHKERRQ(ierr);
468   /* now copy the desired guys from DBIn => DB */
469   for (p = 0; p < N; ++p) {
470     ierr = DataBucketCopyPoint(DBIn,list[p], *DB,p);CHKERRQ(ierr);
471   }
472   PetscFunctionReturn(0);
473 }
474 
475 /* insert into an exisitng location */
476 PetscErrorCode DataFieldInsertPoint(const DataField field,const PetscInt index,const void *ctx)
477 {
478   PetscErrorCode ierr;
479 
480   PetscFunctionBegin;
481 #ifdef DATAFIELD_POINT_ACCESS_GUARD
482   /* check point is valid */
483   if (index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be >= 0");
484   if (index >= field->L) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be < %D",field->L);
485 #endif
486   ierr = PetscMemcpy(__DATATFIELD_point_access(field->data,index,field->atomic_size), ctx, field->atomic_size);CHKERRQ(ierr);
487   PetscFunctionReturn(0);
488 }
489 
490 /* remove data at index - replace with last point */
491 PetscErrorCode DataBucketRemovePointAtIndex(const DataBucket db,const PetscInt index)
492 {
493   PetscInt       f;
494   PetscBool      any_active_fields;
495   PetscErrorCode ierr;
496 
497   PetscFunctionBegin;
498 #ifdef DATAFIELD_POINT_ACCESS_GUARD
499   /* check point is valid */
500   if (index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be >= 0");
501   if (index >= db->allocated) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be < %D",db->L+db->buffer);
502 #endif
503   ierr = DataBucketQueryForActiveFields(db,&any_active_fields);CHKERRQ(ierr);
504   if (any_active_fields) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Cannot safely remove point as at least one DataField is currently being accessed");
505   if (index >= db->L) { /* this point is not in the list - no need to error, but I will anyway */
506     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"You should not be trying to remove point at index=%D since it's < db->L = %D", index, db->L);
507   }
508   if (index != db->L-1) { /* not last point in list */
509     for (f = 0; f < db->nfields; ++f) {
510       DataField field = db->field[f];
511 
512       /* copy then remove */
513       ierr = DataFieldCopyPoint(db->L-1, field, index, field);CHKERRQ(ierr);
514       /* DataFieldZeroPoint(field,index); */
515     }
516   }
517   /* decrement size */
518   /* this will zero out an crap at the end of the list */
519   ierr = DataBucketRemovePoint(db);CHKERRQ(ierr);
520   PetscFunctionReturn(0);
521 }
522 
523 /* copy x into y */
524 PetscErrorCode DataFieldCopyPoint(const PetscInt pid_x,const DataField field_x,
525                         const PetscInt pid_y,const DataField field_y )
526 {
527   PetscErrorCode ierr;
528 
529   PetscFunctionBegin;
530 #ifdef DATAFIELD_POINT_ACCESS_GUARD
531   /* check point is valid */
532   if (pid_x < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"(IN) index must be >= 0");
533   if (pid_x >= field_x->L) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"(IN) index must be < %D",field_x->L);
534   if (pid_y < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"(OUT) index must be >= 0");
535   if (pid_y >= field_y->L) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"(OUT) index must be < %D",field_y->L);
536   if( field_y->atomic_size != field_x->atomic_size ) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"atomic size must match");
537 #endif
538   ierr = PetscMemcpy(__DATATFIELD_point_access(field_y->data,pid_y,field_y->atomic_size),
539                      __DATATFIELD_point_access(field_x->data,pid_x,field_x->atomic_size),
540                      field_y->atomic_size);CHKERRQ(ierr);
541   PetscFunctionReturn(0);
542 }
543 
544 
545 /* zero only the datafield at this point */
546 PetscErrorCode DataFieldZeroPoint(const DataField field,const PetscInt index)
547 {
548   PetscErrorCode ierr;
549 
550   PetscFunctionBegin;
551 #ifdef DATAFIELD_POINT_ACCESS_GUARD
552   /* check point is valid */
553   if (index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be >= 0");
554   if (index >= field->L) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be < %D",field->L);
555 #endif
556   ierr = PetscMemzero(__DATATFIELD_point_access(field->data,index,field->atomic_size), field->atomic_size);CHKERRQ(ierr);
557   PetscFunctionReturn(0);
558 }
559 
560 /* zero ALL data for this point */
561 PetscErrorCode DataBucketZeroPoint(const DataBucket db,const PetscInt index)
562 {
563   PetscInt f;
564   PetscErrorCode ierr;
565 
566   PetscFunctionBegin;
567   /* check point is valid */
568   if (index < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be >= 0");
569   if (index >= db->allocated) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"index must be < %D",db->allocated);
570   for (f = 0; f < db->nfields; ++f) {
571     DataField field = db->field[f];
572     ierr = DataFieldZeroPoint(field,index);CHKERRQ(ierr);
573   }
574   PetscFunctionReturn(0);
575 }
576 
577 /* increment */
578 PetscErrorCode DataBucketAddPoint(DataBucket db)
579 {
580   PetscErrorCode ierr;
581 
582   PetscFunctionBegin;
583   ierr = DataBucketSetSizes(db,db->L+1,DATA_BUCKET_BUFFER_DEFAULT);CHKERRQ(ierr);
584   PetscFunctionReturn(0);
585 }
586 
587 /* decrement */
588 PetscErrorCode DataBucketRemovePoint(DataBucket db)
589 {
590   PetscErrorCode ierr;
591 
592   PetscFunctionBegin;
593   ierr = DataBucketSetSizes(db,db->L-1,DATA_BUCKET_BUFFER_DEFAULT);CHKERRQ(ierr);
594   PetscFunctionReturn(0);
595 }
596 
597 PetscErrorCode DataBucketView_stdout(MPI_Comm comm,DataBucket db)
598 {
599   PetscInt f;
600   double memory_usage_total,memory_usage_total_local = 0.0;
601   PetscErrorCode ierr;
602 
603   PetscFunctionBegin;
604   ierr = PetscPrintf(comm,"DataBucketView: \n");CHKERRQ(ierr);
605   ierr = PetscPrintf(comm,"  L                  = %D \n", db->L);CHKERRQ(ierr);
606   ierr = PetscPrintf(comm,"  buffer             = %D \n", db->buffer);CHKERRQ(ierr);
607   ierr = PetscPrintf(comm,"  allocated          = %D \n", db->allocated);CHKERRQ(ierr);
608   ierr = PetscPrintf(comm,"  nfields registered = %D \n", db->nfields);CHKERRQ(ierr);
609 
610   for (f = 0; f < db->nfields; ++f) {
611     double memory_usage_f = (double)(db->field[f]->atomic_size * db->allocated) * 1.0e-6;
612     memory_usage_total_local += memory_usage_f;
613   }
614   ierr = MPI_Allreduce(&memory_usage_total_local,&memory_usage_total,1,MPI_DOUBLE,MPI_SUM,comm);CHKERRQ(ierr);
615 
616   for (f = 0; f < db->nfields; ++f) {
617     double memory_usage_f = (double)(db->field[f]->atomic_size * db->allocated) * 1.0e-6;
618     ierr = PetscPrintf(comm,"    [%3D] %15s : Mem. usage       = %1.2e (MB) [rank0]\n", f, db->field[f]->name, memory_usage_f );CHKERRQ(ierr);
619     ierr = PetscPrintf(comm,"                            blocksize        = %D \n", db->field[f]->bs);CHKERRQ(ierr);
620     if (db->field[f]->bs != 1) {
621       ierr = PetscPrintf(comm,"                            atomic size      = %zu [full block, bs=%D]\n", db->field[f]->atomic_size,db->field[f]->bs);CHKERRQ(ierr);
622       ierr = PetscPrintf(comm,"                            atomic size/item = %zu \n", db->field[f]->atomic_size/db->field[f]->bs);CHKERRQ(ierr);
623     } else {
624       ierr = PetscPrintf(comm,"                            atomic size      = %zu \n", db->field[f]->atomic_size);CHKERRQ(ierr);
625     }
626   }
627   ierr = PetscPrintf(comm,"  Total mem. usage                           = %1.2e (MB) (collective)\n", memory_usage_total);CHKERRQ(ierr);
628   PetscFunctionReturn(0);
629 }
630 
631 PetscErrorCode DataBucketView_SEQ(MPI_Comm comm,DataBucket db,const char filename[],DataBucketViewType type)
632 {
633   PetscErrorCode ierr;
634 
635   PetscFunctionBegin;
636   switch (type) {
637   case DATABUCKET_VIEW_STDOUT:
638     ierr = DataBucketView_stdout(PETSC_COMM_SELF,db);CHKERRQ(ierr);
639     break;
640   case DATABUCKET_VIEW_ASCII:
641     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for ascii output");
642     break;
643   case DATABUCKET_VIEW_BINARY:
644     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for binary output");
645     break;
646   case DATABUCKET_VIEW_HDF5:
647     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for HDF5 output");
648     break;
649   default: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unknown viewer method requested");
650   }
651   PetscFunctionReturn(0);
652 }
653 
654 PetscErrorCode DataBucketView_MPI(MPI_Comm comm,DataBucket db,const char filename[],DataBucketViewType type)
655 {
656   PetscErrorCode ierr;
657 
658   PetscFunctionBegin;
659   switch (type) {
660   case DATABUCKET_VIEW_STDOUT:
661     ierr = DataBucketView_stdout(comm,db);CHKERRQ(ierr);
662     break;
663   case DATABUCKET_VIEW_ASCII:
664     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for ascii output");
665     break;
666   case DATABUCKET_VIEW_BINARY:
667     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for binary output");
668     break;
669   case DATABUCKET_VIEW_HDF5:
670     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for HDF5 output");
671     break;
672   default: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unknown viewer method requested");
673   }
674   PetscFunctionReturn(0);
675 }
676 
677 PetscErrorCode DataBucketView(MPI_Comm comm,DataBucket db,const char filename[],DataBucketViewType type)
678 {
679   PetscMPIInt nproc;
680   PetscErrorCode ierr;
681 
682   PetscFunctionBegin;
683   ierr = MPI_Comm_size(comm,&nproc);CHKERRQ(ierr);
684   if (nproc == 1) {
685     ierr = DataBucketView_SEQ(comm,db,filename,type);CHKERRQ(ierr);
686   } else {
687     ierr = DataBucketView_MPI(comm,db,filename,type);CHKERRQ(ierr);
688   }
689   PetscFunctionReturn(0);
690 }
691 
692 PetscErrorCode DataBucketDuplicateFields(DataBucket dbA,DataBucket *dbB)
693 {
694   DataBucket db2;
695   PetscInt f;
696   PetscErrorCode ierr;
697 
698   PetscFunctionBegin;
699   ierr = DataBucketCreate(&db2);CHKERRQ(ierr);
700   /* copy contents from dbA into db2 */
701   for (f = 0; f < dbA->nfields; ++f) {
702     DataField field;
703     size_t    atomic_size;
704     char      *name;
705 
706     field = dbA->field[f];
707     atomic_size = field->atomic_size;
708     name        = field->name;
709     ierr = DataBucketRegisterField(db2,"DataBucketDuplicateFields",name,atomic_size,NULL);CHKERRQ(ierr);
710   }
711   ierr = DataBucketFinalize(db2);CHKERRQ(ierr);
712   ierr = DataBucketSetInitialSizes(db2,0,1000);CHKERRQ(ierr);
713   *dbB = db2;
714   PetscFunctionReturn(0);
715 }
716 
717 /*
718  Insert points from db2 into db1
719  db1 <<== db2
720  */
721 PetscErrorCode DataBucketInsertValues(DataBucket db1,DataBucket db2)
722 {
723   PetscInt n_mp_points1,n_mp_points2;
724   PetscInt n_mp_points1_new,p;
725   PetscErrorCode ierr;
726 
727   PetscFunctionBegin;
728   ierr = DataBucketGetSizes(db1,&n_mp_points1,0,0);CHKERRQ(ierr);
729   ierr = DataBucketGetSizes(db2,&n_mp_points2,0,0);CHKERRQ(ierr);
730   n_mp_points1_new = n_mp_points1 + n_mp_points2;
731   ierr = DataBucketSetSizes(db1,n_mp_points1_new,DATA_BUCKET_BUFFER_DEFAULT);CHKERRQ(ierr);
732   for (p = 0; p < n_mp_points2; ++p) {
733     /* db1 <<== db2 */
734     ierr = DataBucketCopyPoint(db2,p, db1,(n_mp_points1 + p));CHKERRQ(ierr);
735   }
736   PetscFunctionReturn(0);
737 }
738 
739 /* helpers for parallel send/recv */
740 PetscErrorCode DataBucketCreatePackedArray(DataBucket db,size_t *bytes,void **buf)
741 {
742   PetscInt       f;
743   size_t         sizeof_marker_contents;
744   void          *buffer;
745   PetscErrorCode ierr;
746 
747   PetscFunctionBegin;
748   sizeof_marker_contents = 0;
749   for (f = 0; f < db->nfields; ++f) {
750     DataField df = db->field[f];
751     sizeof_marker_contents += df->atomic_size;
752   }
753   ierr = PetscMalloc(sizeof_marker_contents, &buffer);CHKERRQ(ierr);
754   ierr = PetscMemzero(buffer, sizeof_marker_contents);CHKERRQ(ierr);
755   if (bytes) {*bytes = sizeof_marker_contents;}
756   if (buf)   {*buf   = buffer;}
757   PetscFunctionReturn(0);
758 }
759 
760 PetscErrorCode DataBucketDestroyPackedArray(DataBucket db,void **buf)
761 {
762   PetscErrorCode ierr;
763 
764   PetscFunctionBegin;
765   if (buf) {
766     ierr = PetscFree(*buf);CHKERRQ(ierr);
767     *buf = NULL;
768   }
769   PetscFunctionReturn(0);
770 }
771 
772 PetscErrorCode DataBucketFillPackedArray(DataBucket db,const PetscInt index,void *buf)
773 {
774   PetscInt       f;
775   void          *data, *data_p;
776   size_t         asize, offset;
777   PetscErrorCode ierr;
778 
779   PetscFunctionBegin;
780   offset = 0;
781   for (f = 0; f < db->nfields; ++f) {
782     DataField df = db->field[f];
783 
784     asize = df->atomic_size;
785     data = (void*)( df->data );
786     data_p = (void*)( (char*)data + index*asize );
787     ierr = PetscMemcpy((void*)((char*)buf + offset), data_p, asize);CHKERRQ(ierr);
788     offset = offset + asize;
789   }
790   PetscFunctionReturn(0);
791 }
792 
793 PetscErrorCode DataBucketInsertPackedArray(DataBucket db,const PetscInt idx,void *data)
794 {
795   PetscInt f;
796   void *data_p;
797   size_t offset;
798   PetscErrorCode ierr;
799 
800   PetscFunctionBegin;
801   offset = 0;
802   for (f = 0; f < db->nfields; ++f) {
803     DataField df = db->field[f];
804 
805     data_p = (void*)( (char*)data + offset );
806     ierr = DataFieldInsertPoint(df, idx, (void*)data_p);CHKERRQ(ierr);
807     offset = offset + df->atomic_size;
808   }
809   PetscFunctionReturn(0);
810 }
811