Actual source code: data_ex.c
petsc-3.8.4 2018-03-24
1: /*
2: Build a few basic tools to help with partitioned domains.
4: 1)
5: On each processor, have a DomainExchangerTopology.
6: This is a doubly-connected edge list which enumerates the
7: communication paths between connected processors. By numbering
8: these paths we can always uniquely assign message identifers.
10: edge
11: 10
12: proc ---------> proc
13: 0 <-------- 1
14: 11
15: twin
17: Eg: Proc 0 send to proc 1 with message id is 10. To recieve the correct
18: message, proc 1 looks for the edge connected to proc 0, and then the
19: messgae id comes from the twin of that edge
21: 2)
22: A DomainExchangerArrayPacker.
23: A little function which given a piece of data, will memcpy the data into
24: an array (which will be sent to procs) into the correct place.
26: On Proc 1 we sent data to procs 0,2,3. The data is on different lengths.
27: All data gets jammed into single array. Need to "jam" data into correct locations
28: The Packer knows how much is to going to each processor and keeps track of the inserts
29: so as to avoid ever packing TOO much into one slot, and inevatbly corrupting some memory
31: data to 0 data to 2 data to 3
33: |--------|-----------------|--|
36: User has to unpack message themselves. I can get you the pointer for each i
37: entry, but you'll have to cast it to the appropriate data type.
42: Phase A: Build topology
44: Phase B: Define message lengths
46: Phase C: Pack data
48: Phase D: Send data
50: + Constructor
51: DataExCreate()
52: + Phase A
53: DataExTopologyInitialize()
54: DataExTopologyAddNeighbour()
55: DataExTopologyAddNeighbour()
56: DataExTopologyFinalize()
57: + Phase B
58: DataExZeroAllSendCount()
59: DataExAddToSendCount()
60: DataExAddToSendCount()
61: DataExAddToSendCount()
62: + Phase C
63: DataExPackInitialize()
64: DataExPackData()
65: DataExPackData()
66: DataExPackFinalize()
67: +Phase D
68: DataExBegin()
69: ... perform any calculations ...
70: DataExEnd()
72: ... user calls any getters here ...
75: */
76: #include <petscvec.h>
77: #include <petscmat.h>
79: #include "data_ex.h"
81: const char *status_names[] = {"initialized", "finalized", "unknown"};
83: PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerTopologySetup;
84: PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerBegin;
85: PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerEnd;
86: PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerSendCount;
87: PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerPack;
89: PetscErrorCode DataExCreate(MPI_Comm comm,const PetscInt count, DataEx *ex)
90: {
92: DataEx d;
95: PetscMalloc(sizeof(struct _p_DataEx), &d);
96: PetscMemzero(d, sizeof(struct _p_DataEx));
97: MPI_Comm_dup(comm,&d->comm);
98: MPI_Comm_rank(d->comm,&d->rank);
100: d->instance = count;
102: d->topology_status = DEOBJECT_STATE_UNKNOWN;
103: d->message_lengths_status = DEOBJECT_STATE_UNKNOWN;
104: d->packer_status = DEOBJECT_STATE_UNKNOWN;
105: d->communication_status = DEOBJECT_STATE_UNKNOWN;
107: d->n_neighbour_procs = -1;
108: d->neighbour_procs = NULL;
110: d->messages_to_be_sent = NULL;
111: d->message_offsets = NULL;
112: d->messages_to_be_recvieved = NULL;
114: d->unit_message_size = -1;
115: d->send_message = NULL;
116: d->send_message_length = -1;
117: d->recv_message = NULL;
118: d->recv_message_length = -1;
119: d->total_pack_cnt = -1;
120: d->pack_cnt = NULL;
122: d->send_tags = NULL;
123: d->recv_tags = NULL;
125: d->_stats = NULL;
126: d->_requests = NULL;
127: *ex = d;
128: return(0);
129: }
131: PetscErrorCode DataExView(DataEx d)
132: {
133: PetscMPIInt p;
137: PetscPrintf( PETSC_COMM_WORLD, "DataEx: instance=%D\n",d->instance);
138: PetscPrintf( PETSC_COMM_WORLD, " topology status: %s \n", status_names[d->topology_status]);
139: PetscPrintf( PETSC_COMM_WORLD, " message lengths status: %s \n", status_names[d->message_lengths_status] );
140: PetscPrintf( PETSC_COMM_WORLD, " packer status status: %s \n", status_names[d->packer_status] );
141: PetscPrintf( PETSC_COMM_WORLD, " communication status: %s \n", status_names[d->communication_status] );
143: if (d->topology_status == DEOBJECT_FINALIZED) {
144: PetscPrintf( PETSC_COMM_WORLD, " Topology:\n");
145: PetscPrintf( PETSC_COMM_SELF, " [%d] neighbours: %d \n", (int)d->rank, (int)d->n_neighbour_procs );
146: for (p=0; p<d->n_neighbour_procs; p++) {
147: PetscPrintf( PETSC_COMM_SELF, " [%d] neighbour[%D] = %d \n", (int)d->rank, p, (int)d->neighbour_procs[p]);
148: }
149: }
150: if (d->message_lengths_status == DEOBJECT_FINALIZED) {
151: PetscPrintf( PETSC_COMM_WORLD, " Message lengths:\n");
152: PetscPrintf( PETSC_COMM_SELF, " [%d] atomic size: %ld \n", (int)d->rank, (long int)d->unit_message_size );
153: for (p=0; p<d->n_neighbour_procs; p++) {
154: PetscPrintf( PETSC_COMM_SELF, " [%d] >>>>> ( %D units :: tag = %d ) >>>>> [%d] \n", (int)d->rank, d->messages_to_be_sent[p], d->send_tags[p], (int)d->neighbour_procs[p] );
155: }
156: for (p=0; p<d->n_neighbour_procs; p++) {
157: PetscPrintf( PETSC_COMM_SELF, " [%d] <<<<< ( %D units :: tag = %d ) <<<<< [%d] \n", (int)d->rank, d->messages_to_be_recvieved[p], d->recv_tags[p], (int)d->neighbour_procs[p] );
158: }
159: }
160: if (d->packer_status == DEOBJECT_FINALIZED) {}
161: if (d->communication_status == DEOBJECT_FINALIZED) {}
162: return(0);
163: }
165: PetscErrorCode DataExDestroy(DataEx d)
166: {
170: MPI_Comm_free(&d->comm);
171: if (d->neighbour_procs) {PetscFree(d->neighbour_procs);}
172: if (d->messages_to_be_sent) {PetscFree(d->messages_to_be_sent);}
173: if (d->message_offsets) {PetscFree(d->message_offsets);}
174: if (d->messages_to_be_recvieved) {PetscFree(d->messages_to_be_recvieved);}
175: if (d->send_message) {PetscFree(d->send_message);}
176: if (d->recv_message) {PetscFree(d->recv_message);}
177: if (d->pack_cnt) {PetscFree(d->pack_cnt);}
178: if (d->send_tags) {PetscFree(d->send_tags);}
179: if (d->recv_tags) {PetscFree(d->recv_tags);}
180: if (d->_stats) {PetscFree(d->_stats);}
181: if (d->_requests) {PetscFree(d->_requests);}
182: PetscFree(d);
183: return(0);
184: }
186: /* === Phase A === */
188: PetscErrorCode DataExTopologyInitialize(DataEx d)
189: {
193: d->topology_status = DEOBJECT_INITIALIZED;
194: d->n_neighbour_procs = 0;
195: PetscFree(d->neighbour_procs);
196: PetscFree(d->messages_to_be_sent);
197: PetscFree(d->message_offsets);
198: PetscFree(d->messages_to_be_recvieved);
199: PetscFree(d->pack_cnt);
200: PetscFree(d->send_tags);
201: PetscFree(d->recv_tags);
202: return(0);
203: }
205: PetscErrorCode DataExTopologyAddNeighbour(DataEx d,const PetscMPIInt proc_id)
206: {
207: PetscMPIInt n,found;
208: PetscMPIInt nproc;
212: if (d->topology_status == DEOBJECT_FINALIZED) SETERRQ(d->comm, PETSC_ERR_ARG_WRONGSTATE, "Topology has been finalized. To modify or update call DataExTopologyInitialize() first");
213: else if (d->topology_status != DEOBJECT_INITIALIZED) SETERRQ(d->comm, PETSC_ERR_ARG_WRONGSTATE, "Topology must be intialised. Call DataExTopologyInitialize() first");
215: /* error on negative entries */
216: if (proc_id < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Trying to set proc neighbour with a rank < 0");
217: /* error on ranks larger than number of procs in communicator */
218: MPI_Comm_size(d->comm,&nproc);
219: if (proc_id >= nproc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Trying to set proc neighbour with a rank >= nproc");
220: if (d->n_neighbour_procs == 0) {PetscMalloc1(1, &d->neighbour_procs);}
221: /* check for proc_id */
222: found = 0;
223: for (n = 0; n < d->n_neighbour_procs; n++) {
224: if (d->neighbour_procs[n] == proc_id) {
225: found = 1;
226: }
227: }
228: if (found == 0) { /* add it to list */
229: PetscRealloc(sizeof(PetscMPIInt)*(d->n_neighbour_procs+1), &d->neighbour_procs);
230: d->neighbour_procs[ d->n_neighbour_procs ] = proc_id;
231: d->n_neighbour_procs++;
232: }
233: return(0);
234: }
236: /*
237: counter: the index of the communication object
238: N: the number of processors
239: r0: rank of sender
240: r1: rank of receiver
242: procs = { 0, 1, 2, 3 }
244: 0 ==> 0 e=0
245: 0 ==> 1 e=1
246: 0 ==> 2 e=2
247: 0 ==> 3 e=3
249: 1 ==> 0 e=4
250: 1 ==> 1 e=5
251: 1 ==> 2 e=6
252: 1 ==> 3 e=7
254: 2 ==> 0 e=8
255: 2 ==> 1 e=9
256: 2 ==> 2 e=10
257: 2 ==> 3 e=11
259: 3 ==> 0 e=12
260: 3 ==> 1 e=13
261: 3 ==> 2 e=14
262: 3 ==> 3 e=15
264: If we require that proc A sends to proc B, then the SEND tag index will be given by
265: N * rank(A) + rank(B) + offset
266: If we require that proc A will receive from proc B, then the RECV tag index will be given by
267: N * rank(B) + rank(A) + offset
269: */
270: static void _get_tags(PetscInt counter, PetscMPIInt N, PetscMPIInt r0,PetscMPIInt r1, PetscMPIInt *_st, PetscMPIInt *_rt)
271: {
272: PetscMPIInt st,rt;
274: st = N*r0 + r1 + N*N*counter;
275: rt = N*r1 + r0 + N*N*counter;
276: *_st = st;
277: *_rt = rt;
278: }
280: /*
281: Makes the communication map symmetric
282: */
283: PetscErrorCode _DataExCompleteCommunicationMap(MPI_Comm comm,PetscMPIInt n,PetscMPIInt proc_neighbours[],PetscMPIInt *n_new,PetscMPIInt **proc_neighbours_new)
284: {
285: Mat A;
286: PetscInt i,j,nc;
287: PetscInt n_, *proc_neighbours_;
288: PetscInt rank_i_;
289: PetscMPIInt size, rank_i;
290: PetscScalar *vals;
291: const PetscInt *cols;
292: const PetscScalar *red_vals;
293: PetscMPIInt _n_new, *_proc_neighbours_new;
294: PetscErrorCode ierr;
297: n_ = n;
298: PetscMalloc(sizeof(PetscInt) * n_, &proc_neighbours_);
299: for (i = 0; i < n_; ++i) {
300: proc_neighbours_[i] = proc_neighbours[i];
301: }
302: MPI_Comm_size(comm,&size);
303: MPI_Comm_rank(comm,&rank_i);
304: rank_i_ = rank_i;
306: MatCreate(comm,&A);
307: MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,size,size);
308: MatSetType(A,MATAIJ);
309: MatSeqAIJSetPreallocation(A,1,NULL);
310: MatMPIAIJSetPreallocation(A,n_,NULL,n_,NULL);
311: MatSetOption(A, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);
312: /* Build original map */
313: PetscMalloc1(n_, &vals);
314: for (i = 0; i < n_; ++i) {
315: vals[i] = 1.0;
316: }
317: MatSetValues( A, 1,&rank_i_, n_,proc_neighbours_, vals, INSERT_VALUES );
318: MatAssemblyBegin(A,MAT_FLUSH_ASSEMBLY);
319: MatAssemblyEnd(A,MAT_FLUSH_ASSEMBLY);
320: /* Now force all other connections if they are not already there */
321: /* It's more efficient to do them all at once */
322: for (i = 0; i < n_; ++i) {
323: vals[i] = 2.0;
324: }
325: MatSetValues( A, n_,proc_neighbours_, 1,&rank_i_, vals, INSERT_VALUES );
326: MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
327: MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
328: /*
329: PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);
330: MatView(A,PETSC_VIEWER_STDOUT_WORLD);
331: PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);
332: */
333: if ((n_new != NULL) && (proc_neighbours_new != NULL)) {
334: MatGetRow(A, rank_i_, &nc, &cols, &red_vals);
335: _n_new = (PetscMPIInt) nc;
336: PetscMalloc1(_n_new, &_proc_neighbours_new);
337: for (j = 0; j < nc; ++j) {
338: _proc_neighbours_new[j] = (PetscMPIInt)cols[j];
339: }
340: MatRestoreRow( A, rank_i_, &nc, &cols, &red_vals );
341: *n_new = (PetscMPIInt)_n_new;
342: *proc_neighbours_new = (PetscMPIInt*)_proc_neighbours_new;
343: }
344: MatDestroy(&A);
345: PetscFree(vals);
346: PetscFree(proc_neighbours_);
347: MPI_Barrier(comm);
348: return(0);
349: }
351: PetscErrorCode DataExTopologyFinalize(DataEx d)
352: {
353: PetscMPIInt symm_nn;
354: PetscMPIInt *symm_procs;
355: PetscMPIInt r0,n,st,rt;
356: PetscMPIInt nprocs;
360: if (d->topology_status != DEOBJECT_INITIALIZED) SETERRQ(d->comm, PETSC_ERR_ARG_WRONGSTATE, "Topology must be intialised. Call DataExTopologyInitialize() first");
362: PetscLogEventBegin(DMSWARM_DataExchangerTopologySetup,0,0,0,0);
363: /* given infomation about all my neighbours, make map symmetric */
364: _DataExCompleteCommunicationMap( d->comm,d->n_neighbour_procs,d->neighbour_procs, &symm_nn, &symm_procs );
365: /* update my arrays */
366: PetscFree(d->neighbour_procs);
367: d->n_neighbour_procs = symm_nn;
368: d->neighbour_procs = symm_procs;
369: /* allocates memory */
370: if (!d->messages_to_be_sent) {PetscMalloc1(d->n_neighbour_procs+1, &d->messages_to_be_sent);}
371: if (!d->message_offsets) {PetscMalloc1(d->n_neighbour_procs+1, &d->message_offsets);}
372: if (!d->messages_to_be_recvieved) {PetscMalloc1(d->n_neighbour_procs+1, &d->messages_to_be_recvieved);}
373: if (!d->pack_cnt) {PetscMalloc(sizeof(PetscInt) * d->n_neighbour_procs, &d->pack_cnt);}
374: if (!d->_stats) {PetscMalloc(sizeof(MPI_Status) * 2*d->n_neighbour_procs, &d->_stats);}
375: if (!d->_requests) {PetscMalloc(sizeof(MPI_Request) * 2*d->n_neighbour_procs, &d->_requests);}
376: if (!d->send_tags) {PetscMalloc(sizeof(int) * d->n_neighbour_procs, &d->send_tags);}
377: if (!d->recv_tags) {PetscMalloc(sizeof(int) * d->n_neighbour_procs, &d->recv_tags);}
378: /* compute message tags */
379: MPI_Comm_size(d->comm,&nprocs);
380: r0 = d->rank;
381: for (n = 0; n < d->n_neighbour_procs; ++n) {
382: PetscMPIInt r1 = d->neighbour_procs[n];
384: _get_tags( d->instance, nprocs, r0,r1, &st, &rt );
385: d->send_tags[n] = (int)st;
386: d->recv_tags[n] = (int)rt;
387: }
388: d->topology_status = DEOBJECT_FINALIZED;
389: PetscLogEventEnd(DMSWARM_DataExchangerTopologySetup,0,0,0,0);
390: return(0);
391: }
393: /* === Phase B === */
394: PetscErrorCode _DataExConvertProcIdToLocalIndex(DataEx de,PetscMPIInt proc_id,PetscMPIInt *local)
395: {
396: PetscMPIInt i,np;
399: np = de->n_neighbour_procs;
400: *local = -1;
401: for (i = 0; i < np; ++i) {
402: if (proc_id == de->neighbour_procs[i]) {
403: *local = i;
404: break;
405: }
406: }
407: return(0);
408: }
410: PetscErrorCode DataExInitializeSendCount(DataEx de)
411: {
412: PetscMPIInt i;
416: if (de->topology_status != DEOBJECT_FINALIZED) SETERRQ(de->comm, PETSC_ERR_ORDER, "Topology not finalized");
417: PetscLogEventBegin(DMSWARM_DataExchangerSendCount,0,0,0,0);
418: de->message_lengths_status = DEOBJECT_INITIALIZED;
419: for (i = 0; i < de->n_neighbour_procs; ++i) {
420: de->messages_to_be_sent[i] = 0;
421: }
422: return(0);
423: }
425: /*
426: 1) only allows counters to be set on neighbouring cpus
427: */
428: PetscErrorCode DataExAddToSendCount(DataEx de,const PetscMPIInt proc_id,const PetscInt count)
429: {
430: PetscMPIInt local_val;
434: if (de->message_lengths_status == DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Message lengths have been defined. To modify these call DataExInitializeSendCount() first" );
435: else if (de->message_lengths_status != DEOBJECT_INITIALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Message lengths must be defined. Call DataExInitializeSendCount() first" );
436:
437: _DataExConvertProcIdToLocalIndex( de, proc_id, &local_val );
438: if (local_val == -1) SETERRQ1( PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG,"Proc %d is not a valid neighbour rank", (int)proc_id );
439:
440: de->messages_to_be_sent[local_val] = de->messages_to_be_sent[local_val] + count;
441: return(0);
442: }
444: PetscErrorCode DataExFinalizeSendCount(DataEx de)
445: {
447:
449: if (de->message_lengths_status != DEOBJECT_INITIALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Message lengths must be defined. Call DataExInitializeSendCount() first" );
450:
451: de->message_lengths_status = DEOBJECT_FINALIZED;
452: PetscLogEventEnd(DMSWARM_DataExchangerSendCount,0,0,0,0);
453: return(0);
454: }
456: /* === Phase C === */
457: /*
458: * zero out all send counts
459: * free send and recv buffers
460: * zeros out message length
461: * zeros out all counters
462: * zero out packed data counters
463: */
464: PetscErrorCode _DataExInitializeTmpStorage(DataEx de)
465: {
466: PetscMPIInt i, np;
470: /*if (de->n_neighbour_procs < 0) SETERRQ( PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Number of neighbour procs < 0");
471: */
472: /*
473: if (!de->neighbour_procs) SETERRQ( PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "Neighbour proc list is NULL" );
474: */
475: np = de->n_neighbour_procs;
476: for (i = 0; i < np; ++i) {
477: /* de->messages_to_be_sent[i] = -1; */
478: de->messages_to_be_recvieved[i] = -1;
479: }
480: PetscFree(de->send_message);
481: PetscFree(de->recv_message);
482: return(0);
483: }
485: /*
486: *) Zeros out pack data counters
487: *) Ensures mesaage length is set
488: *) Checks send counts properly initialized
489: *) allocates space for pack data
490: */
491: PetscErrorCode DataExPackInitialize(DataEx de,size_t unit_message_size)
492: {
493: PetscMPIInt i,np;
494: PetscInt total;
498: if (de->topology_status != DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Topology not finalized" );
499: if (de->message_lengths_status != DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Message lengths not finalized" );
500: PetscLogEventBegin(DMSWARM_DataExchangerPack,0,0,0,0);
501: de->packer_status = DEOBJECT_INITIALIZED;
502: _DataExInitializeTmpStorage(de);
503: np = de->n_neighbour_procs;
504: de->unit_message_size = unit_message_size;
505: total = 0;
506: for (i = 0; i < np; ++i) {
507: if (de->messages_to_be_sent[i] == -1) {
508: PetscMPIInt proc_neighour = de->neighbour_procs[i];
509: SETERRQ1( PETSC_COMM_SELF, PETSC_ERR_ORDER, "Messages_to_be_sent[neighbour_proc=%d] is un-initialised. Call DataExSetSendCount() first", (int)proc_neighour );
510: }
511: total = total + de->messages_to_be_sent[i];
512: }
513: /* create space for the data to be sent */
514: PetscMalloc(unit_message_size * (total + 1), &de->send_message);
515: /* initialize memory */
516: PetscMemzero(de->send_message, unit_message_size * (total + 1));
517: /* set total items to send */
518: de->send_message_length = total;
519: de->message_offsets[0] = 0;
520: total = de->messages_to_be_sent[0];
521: for (i = 1; i < np; ++i) {
522: de->message_offsets[i] = total;
523: total = total + de->messages_to_be_sent[i];
524: }
525: /* init the packer counters */
526: de->total_pack_cnt = 0;
527: for (i = 0; i < np; ++i) {
528: de->pack_cnt[i] = 0;
529: }
530: return(0);
531: }
533: /*
534: *) Ensures data gets been packed appropriately and no overlaps occur
535: */
536: PetscErrorCode DataExPackData(DataEx de,PetscMPIInt proc_id,PetscInt n,void *data)
537: {
538: PetscMPIInt local;
539: PetscInt insert_location;
540: void *dest;
544: if (de->packer_status == DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Packed data have been defined. To modify these call DataExInitializeSendCount(), DataExAddToSendCount(), DataExPackInitialize() first" );
545: else if (de->packer_status != DEOBJECT_INITIALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Packed data must be defined. Call DataExInitializeSendCount(), DataExAddToSendCount(), DataExPackInitialize() first" );
546:
547: if (!de->send_message) SETERRQ( de->comm, PETSC_ERR_ORDER, "send_message is not initialized. Call DataExPackInitialize() first" );
548: _DataExConvertProcIdToLocalIndex( de, proc_id, &local );
549: if (local == -1) SETERRQ1( PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "proc_id %d is not registered neighbour", (int)proc_id );
550: if (n+de->pack_cnt[local] > de->messages_to_be_sent[local]) SETERRQ3( PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Trying to pack too many entries to be sent to proc %d. Space requested = %D: Attempt to insert %D",
551: (int)proc_id, de->messages_to_be_sent[local], n+de->pack_cnt[local] );
553: /* copy memory */
554: insert_location = de->message_offsets[local] + de->pack_cnt[local];
555: dest = ((char*)de->send_message) + de->unit_message_size*insert_location;
556: PetscMemcpy(dest, data, de->unit_message_size * n);
557: /* increment counter */
558: de->pack_cnt[local] = de->pack_cnt[local] + n;
559: return(0);
560: }
562: /*
563: *) Ensures all data has been packed
564: */
565: PetscErrorCode DataExPackFinalize(DataEx de)
566: {
567: PetscMPIInt i,np;
568: PetscInt total;
572: if (de->packer_status != DEOBJECT_INITIALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Packer has not been initialized. Must call DataExPackInitialize() first." );
573: np = de->n_neighbour_procs;
574: for (i = 0; i < np; ++i) {
575: if (de->pack_cnt[i] != de->messages_to_be_sent[i]) SETERRQ3( PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Not all messages for neighbour[%d] have been packed. Expected %D : Inserted %D",
576: (int)de->neighbour_procs[i], de->messages_to_be_sent[i], de->pack_cnt[i] );
577: }
578: /* init */
579: for (i = 0; i < np; ++i) {
580: de->messages_to_be_recvieved[i] = -1;
581: }
582: /* figure out the recv counts here */
583: for (i = 0; i < np; ++i) {
584: MPI_Isend(&de->messages_to_be_sent[i], 1, MPIU_INT, de->neighbour_procs[i], de->send_tags[i], de->comm, &de->_requests[i]);
585: }
586: for (i = 0; i < np; ++i) {
587: MPI_Irecv(&de->messages_to_be_recvieved[i], 1, MPIU_INT, de->neighbour_procs[i], de->recv_tags[i], de->comm, &de->_requests[np+i]);
588: }
589: MPI_Waitall(2*np, de->_requests, de->_stats);
590: /* create space for the data to be recvieved */
591: total = 0;
592: for (i = 0; i < np; ++i) {
593: total = total + de->messages_to_be_recvieved[i];
594: }
595: PetscMalloc(de->unit_message_size * (total + 1), &de->recv_message);
596: /* initialize memory */
597: PetscMemzero(de->recv_message, de->unit_message_size * (total + 1));
598: /* set total items to recieve */
599: de->recv_message_length = total;
600: de->packer_status = DEOBJECT_FINALIZED;
601: de->communication_status = DEOBJECT_INITIALIZED;
602: PetscLogEventEnd(DMSWARM_DataExchangerPack,0,0,0,0);
603: return(0);
604: }
606: /* do the actual message passing now */
607: PetscErrorCode DataExBegin(DataEx de)
608: {
609: PetscMPIInt i,np;
610: void *dest;
611: PetscInt length;
615: if (de->topology_status != DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Topology not finalized" );
616: if (de->message_lengths_status != DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Message lengths not finalized" );
617: if (de->packer_status != DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Packer not finalized" );
618: if (de->communication_status == DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Communication has already been finalized. Must call DataExInitialize() first." );
619: if (!de->recv_message) SETERRQ( de->comm, PETSC_ERR_ORDER, "recv_message has not been initialized. Must call DataExPackFinalize() first" );
620: PetscLogEventBegin(DMSWARM_DataExchangerBegin,0,0,0,0);
621: np = de->n_neighbour_procs;
622: /* == NON BLOCKING == */
623: for (i = 0; i < np; ++i) {
624: length = de->messages_to_be_sent[i] * de->unit_message_size;
625: dest = ((char*)de->send_message) + de->unit_message_size * de->message_offsets[i];
626: MPI_Isend( dest, length, MPI_CHAR, de->neighbour_procs[i], de->send_tags[i], de->comm, &de->_requests[i] );
627: }
628: PetscLogEventEnd(DMSWARM_DataExchangerBegin,0,0,0,0);
629: return(0);
630: }
632: /* do the actual message passing now */
633: PetscErrorCode DataExEnd(DataEx de)
634: {
635: PetscMPIInt i,np;
636: PetscInt total;
637: PetscInt *message_recv_offsets;
638: void *dest;
639: PetscInt length;
643: if (de->communication_status != DEOBJECT_INITIALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Communication has not been initialized. Must call DataExInitialize() first." );
644: if (!de->recv_message) SETERRQ( de->comm, PETSC_ERR_ORDER, "recv_message has not been initialized. Must call DataExPackFinalize() first" );
645: PetscLogEventBegin(DMSWARM_DataExchangerEnd,0,0,0,0);
646: np = de->n_neighbour_procs;
647: PetscMalloc1(np+1, &message_recv_offsets);
648: message_recv_offsets[0] = 0;
649: total = de->messages_to_be_recvieved[0];
650: for (i = 1; i < np; ++i) {
651: message_recv_offsets[i] = total;
652: total = total + de->messages_to_be_recvieved[i];
653: }
654: /* == NON BLOCKING == */
655: for (i = 0; i < np; ++i) {
656: length = de->messages_to_be_recvieved[i] * de->unit_message_size;
657: dest = ((char*)de->recv_message) + de->unit_message_size * message_recv_offsets[i];
658: MPI_Irecv( dest, length, MPI_CHAR, de->neighbour_procs[i], de->recv_tags[i], de->comm, &de->_requests[np+i] );
659: }
660: MPI_Waitall( 2*np, de->_requests, de->_stats );
661: PetscFree(message_recv_offsets);
662: de->communication_status = DEOBJECT_FINALIZED;
663: PetscLogEventEnd(DMSWARM_DataExchangerEnd,0,0,0,0);
664: return(0);
665: }
667: PetscErrorCode DataExGetSendData(DataEx de,PetscInt *length,void **send)
668: {
670: if (de->packer_status != DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ARG_WRONGSTATE, "Data has not finished being packed." );
671: *length = de->send_message_length;
672: *send = de->send_message;
673: return(0);
674: }
676: PetscErrorCode DataExGetRecvData(DataEx de,PetscInt *length,void **recv)
677: {
679: if (de->communication_status != DEOBJECT_FINALIZED) SETERRQ( de->comm, PETSC_ERR_ARG_WRONGSTATE, "Data has not finished being sent." );
680: *length = de->recv_message_length;
681: *recv = de->recv_message;
682: return(0);
683: }
685: PetscErrorCode DataExTopologyGetNeighbours(DataEx de,PetscMPIInt *n,PetscMPIInt *neigh[])
686: {
688: if (n) {*n = de->n_neighbour_procs;}
689: if (neigh) {*neigh = de->neighbour_procs;}
690: return(0);
691: }