xref: /petsc/src/dm/impls/swarm/data_ex.c (revision e600fa544e2bb197ca2af9b6e65ea465976dec56)
1 /*
2 Build a few basic tools to help with partitioned domains.
3 
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.
9 
10         edge
11          10
12 proc  --------->  proc
13  0    <--------    1
14          11
15         twin
16 
17 Eg: Proc 0 send to proc 1 with message id is 10. To receive the correct
18 message, proc 1 looks for the edge connected to proc 0, and then the
19 message id comes from the twin of that edge
20 
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.
25 
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
30 
31 data to 0    data to 2       data to 3
32 
33 |--------|-----------------|--|
34 
35 User has to unpack message themselves. I can get you the pointer for each i
36 entry, but you'll have to cast it to the appropriate data type.
37 
38 Phase A: Build topology
39 
40 Phase B: Define message lengths
41 
42 Phase C: Pack data
43 
44 Phase D: Send data
45 
46 + Constructor
47 DMSwarmDataExCreate()
48 + Phase A
49 DMSwarmDataExTopologyInitialize()
50 DMSwarmDataExTopologyAddNeighbour()
51 DMSwarmDataExTopologyAddNeighbour()
52 DMSwarmDataExTopologyFinalize()
53 + Phase B
54 DMSwarmDataExZeroAllSendCount()
55 DMSwarmDataExAddToSendCount()
56 DMSwarmDataExAddToSendCount()
57 DMSwarmDataExAddToSendCount()
58 + Phase C
59 DMSwarmDataExPackInitialize()
60 DMSwarmDataExPackData()
61 DMSwarmDataExPackData()
62 DMSwarmDataExPackFinalize()
63 +Phase D
64 DMSwarmDataExBegin()
65  ... perform any calculations ...
66 DMSwarmDataExEnd()
67 
68 ... user calls any getters here ...
69 
70 */
71 #include <petscvec.h>
72 #include <petscmat.h>
73 
74 #include "../src/dm/impls/swarm/data_ex.h"
75 
76 const char *status_names[] = {"initialized", "finalized", "unknown"};
77 
78 PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerTopologySetup;
79 PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerBegin;
80 PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerEnd;
81 PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerSendCount;
82 PETSC_EXTERN PetscLogEvent DMSWARM_DataExchangerPack;
83 
84 PetscErrorCode DMSwarmDataExCreate(MPI_Comm comm,const PetscInt count, DMSwarmDataEx *ex)
85 {
86   PetscErrorCode ierr;
87   DMSwarmDataEx  d;
88 
89   PetscFunctionBegin;
90   ierr = PetscNew(&d);CHKERRQ(ierr);
91   ierr = MPI_Comm_dup(comm,&d->comm);CHKERRMPI(ierr);
92   ierr = MPI_Comm_rank(d->comm,&d->rank);CHKERRMPI(ierr);
93 
94   d->instance = count;
95 
96   d->topology_status        = DEOBJECT_STATE_UNKNOWN;
97   d->message_lengths_status = DEOBJECT_STATE_UNKNOWN;
98   d->packer_status          = DEOBJECT_STATE_UNKNOWN;
99   d->communication_status   = DEOBJECT_STATE_UNKNOWN;
100 
101   d->n_neighbour_procs = -1;
102   d->neighbour_procs   = NULL;
103 
104   d->messages_to_be_sent      = NULL;
105   d->message_offsets          = NULL;
106   d->messages_to_be_recvieved = NULL;
107 
108   d->unit_message_size   = (size_t)-1;
109   d->send_message        = NULL;
110   d->send_message_length = -1;
111   d->recv_message        = NULL;
112   d->recv_message_length = -1;
113   d->total_pack_cnt      = -1;
114   d->pack_cnt            = NULL;
115 
116   d->send_tags = NULL;
117   d->recv_tags = NULL;
118 
119   d->_stats    = NULL;
120   d->_requests = NULL;
121   *ex = d;
122   PetscFunctionReturn(0);
123 }
124 
125 /*
126     This code is horrible, who let it get into main.
127 
128     Should be printing to a viewer, should not be using PETSC_COMM_WORLD
129 
130 */
131 PetscErrorCode DMSwarmDataExView(DMSwarmDataEx d)
132 {
133   PetscMPIInt    p;
134   PetscErrorCode ierr;
135 
136   PetscFunctionBegin;
137   ierr = PetscPrintf( PETSC_COMM_WORLD, "DMSwarmDataEx: instance=%D\n",d->instance);CHKERRQ(ierr);
138   ierr = PetscPrintf( PETSC_COMM_WORLD, "  topology status:        %s \n", status_names[d->topology_status]);CHKERRQ(ierr);
139   ierr = PetscPrintf( PETSC_COMM_WORLD, "  message lengths status: %s \n", status_names[d->message_lengths_status]);CHKERRQ(ierr);
140   ierr = PetscPrintf( PETSC_COMM_WORLD, "  packer status status:   %s \n", status_names[d->packer_status]);CHKERRQ(ierr);
141   ierr = PetscPrintf( PETSC_COMM_WORLD, "  communication status:   %s \n", status_names[d->communication_status]);CHKERRQ(ierr);
142 
143   if (d->topology_status == DEOBJECT_FINALIZED) {
144     ierr = PetscPrintf( PETSC_COMM_WORLD, "  Topology:\n");CHKERRQ(ierr);
145     ierr = PetscSynchronizedPrintf( PETSC_COMM_WORLD, "    [%d] neighbours: %d \n", d->rank, d->n_neighbour_procs);CHKERRQ(ierr);
146     for (p=0; p<d->n_neighbour_procs; p++) {
147       ierr = PetscSynchronizedPrintf( PETSC_COMM_WORLD, "    [%d]   neighbour[%d] = %d \n", d->rank, p, d->neighbour_procs[p]);CHKERRQ(ierr);
148     }
149     ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,stdout);CHKERRQ(ierr);
150   }
151 
152   if (d->message_lengths_status == DEOBJECT_FINALIZED) {
153     ierr = PetscPrintf( PETSC_COMM_WORLD, "  Message lengths:\n");CHKERRQ(ierr);
154     ierr = PetscSynchronizedPrintf( PETSC_COMM_WORLD, "    [%d] atomic size: %ld \n", d->rank, (long int)d->unit_message_size);CHKERRQ(ierr);
155     for (p=0; p<d->n_neighbour_procs; p++) {
156       ierr = PetscSynchronizedPrintf( PETSC_COMM_WORLD, "    [%d] >>>>> ( %D units :: tag = %d) >>>>> [%d] \n", d->rank, d->messages_to_be_sent[p], d->send_tags[p], d->neighbour_procs[p]);CHKERRQ(ierr);
157     }
158     for (p=0; p<d->n_neighbour_procs; p++) {
159       ierr = PetscSynchronizedPrintf( PETSC_COMM_WORLD, "    [%d] <<<<< ( %D units :: tag = %d) <<<<< [%d] \n", d->rank, d->messages_to_be_recvieved[p], d->recv_tags[p], d->neighbour_procs[p]);CHKERRQ(ierr);
160     }
161     ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,stdout);CHKERRQ(ierr);
162   }
163   if (d->packer_status == DEOBJECT_FINALIZED) {}
164   if (d->communication_status == DEOBJECT_FINALIZED) {}
165   PetscFunctionReturn(0);
166 }
167 
168 PetscErrorCode DMSwarmDataExDestroy(DMSwarmDataEx d)
169 {
170   PetscErrorCode ierr;
171 
172   PetscFunctionBegin;
173   ierr = MPI_Comm_free(&d->comm);CHKERRMPI(ierr);
174   if (d->neighbour_procs) {ierr = PetscFree(d->neighbour_procs);CHKERRQ(ierr);}
175   if (d->messages_to_be_sent) {ierr = PetscFree(d->messages_to_be_sent);CHKERRQ(ierr);}
176   if (d->message_offsets) {ierr = PetscFree(d->message_offsets);CHKERRQ(ierr);}
177   if (d->messages_to_be_recvieved) {ierr = PetscFree(d->messages_to_be_recvieved);CHKERRQ(ierr);}
178   if (d->send_message) {ierr = PetscFree(d->send_message);CHKERRQ(ierr);}
179   if (d->recv_message) {ierr = PetscFree(d->recv_message);CHKERRQ(ierr);}
180   if (d->pack_cnt) {ierr = PetscFree(d->pack_cnt);CHKERRQ(ierr);}
181   if (d->send_tags) {ierr = PetscFree(d->send_tags);CHKERRQ(ierr);}
182   if (d->recv_tags) {ierr = PetscFree(d->recv_tags);CHKERRQ(ierr);}
183   if (d->_stats) {ierr = PetscFree(d->_stats);CHKERRQ(ierr);}
184   if (d->_requests) {ierr = PetscFree(d->_requests);CHKERRQ(ierr);}
185   ierr = PetscFree(d);CHKERRQ(ierr);
186   PetscFunctionReturn(0);
187 }
188 
189 /* === Phase A === */
190 
191 PetscErrorCode DMSwarmDataExTopologyInitialize(DMSwarmDataEx d)
192 {
193   PetscErrorCode ierr;
194 
195   PetscFunctionBegin;
196   d->topology_status = DEOBJECT_INITIALIZED;
197   d->n_neighbour_procs = 0;
198   ierr = PetscFree(d->neighbour_procs);CHKERRQ(ierr);
199   ierr = PetscFree(d->messages_to_be_sent);CHKERRQ(ierr);
200   ierr = PetscFree(d->message_offsets);CHKERRQ(ierr);
201   ierr = PetscFree(d->messages_to_be_recvieved);CHKERRQ(ierr);
202   ierr = PetscFree(d->pack_cnt);CHKERRQ(ierr);
203   ierr = PetscFree(d->send_tags);CHKERRQ(ierr);
204   ierr = PetscFree(d->recv_tags);CHKERRQ(ierr);
205   PetscFunctionReturn(0);
206 }
207 
208 PetscErrorCode DMSwarmDataExTopologyAddNeighbour(DMSwarmDataEx d,const PetscMPIInt proc_id)
209 {
210   PetscMPIInt    n,found;
211   PetscMPIInt    size;
212   PetscErrorCode ierr;
213 
214   PetscFunctionBegin;
215   PetscCheckFalse(d->topology_status == DEOBJECT_FINALIZED,d->comm, PETSC_ERR_ARG_WRONGSTATE, "Topology has been finalized. To modify or update call DMSwarmDataExTopologyInitialize() first");
216   else PetscCheckFalse(d->topology_status != DEOBJECT_INITIALIZED,d->comm, PETSC_ERR_ARG_WRONGSTATE, "Topology must be initialised. Call DMSwarmDataExTopologyInitialize() first");
217 
218   /* error on negative entries */
219   PetscCheckFalse(proc_id < 0,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Trying to set proc neighbour with a rank < 0");
220   /* error on ranks larger than number of procs in communicator */
221   ierr = MPI_Comm_size(d->comm,&size);CHKERRMPI(ierr);
222   PetscCheckFalse(proc_id >= size,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Trying to set proc neighbour %d with a rank >= size %d",proc_id,size);
223   if (d->n_neighbour_procs == 0) {ierr = PetscMalloc1(1, &d->neighbour_procs);CHKERRQ(ierr);}
224   /* check for proc_id */
225   found = 0;
226   for (n = 0; n < d->n_neighbour_procs; n++) {
227     if (d->neighbour_procs[n] == proc_id) {
228       found  = 1;
229     }
230   }
231   if (found == 0) { /* add it to list */
232     ierr = PetscRealloc(sizeof(PetscMPIInt)*(d->n_neighbour_procs+1), &d->neighbour_procs);CHKERRQ(ierr);
233     d->neighbour_procs[ d->n_neighbour_procs ] = proc_id;
234     d->n_neighbour_procs++;
235   }
236   PetscFunctionReturn(0);
237 }
238 
239 /*
240 counter: the index of the communication object
241 N: the number of processors
242 r0: rank of sender
243 r1: rank of receiver
244 
245 procs = { 0, 1, 2, 3 }
246 
247 0 ==> 0         e=0
248 0 ==> 1         e=1
249 0 ==> 2         e=2
250 0 ==> 3         e=3
251 
252 1 ==> 0         e=4
253 1 ==> 1         e=5
254 1 ==> 2         e=6
255 1 ==> 3         e=7
256 
257 2 ==> 0         e=8
258 2 ==> 1         e=9
259 2 ==> 2         e=10
260 2 ==> 3         e=11
261 
262 3 ==> 0         e=12
263 3 ==> 1         e=13
264 3 ==> 2         e=14
265 3 ==> 3         e=15
266 
267 If we require that proc A sends to proc B, then the SEND tag index will be given by
268   N * rank(A) + rank(B) + offset
269 If we require that proc A will receive from proc B, then the RECV tag index will be given by
270   N * rank(B) + rank(A) + offset
271 
272 */
273 static void _get_tags(PetscInt counter, PetscMPIInt N, PetscMPIInt r0,PetscMPIInt r1, PetscMPIInt *_st, PetscMPIInt *_rt)
274 {
275   PetscMPIInt st,rt;
276 
277   st = N*r0 + r1   +   N*N*counter;
278   rt = N*r1 + r0   +   N*N*counter;
279   *_st = st;
280   *_rt = rt;
281 }
282 
283 /*
284 Makes the communication map symmetric
285 */
286 PetscErrorCode _DMSwarmDataExCompleteCommunicationMap(MPI_Comm comm,PetscMPIInt n,PetscMPIInt proc_neighbours[],PetscMPIInt *n_new,PetscMPIInt **proc_neighbours_new)
287 {
288   Mat               A;
289   PetscInt          i,j,nc;
290   PetscInt          n_, *proc_neighbours_;
291   PetscInt          rank_;
292   PetscMPIInt       size,  rank;
293   PetscScalar       *vals;
294   const PetscInt    *cols;
295   const PetscScalar *red_vals;
296   PetscMPIInt       _n_new, *_proc_neighbours_new;
297   PetscErrorCode    ierr;
298 
299   PetscFunctionBegin;
300   n_ = n;
301   ierr = PetscMalloc(sizeof(PetscInt) * n_, &proc_neighbours_);CHKERRQ(ierr);
302   for (i = 0; i < n_; ++i) {
303     proc_neighbours_[i] = proc_neighbours[i];
304   }
305   ierr = MPI_Comm_size(comm,&size);CHKERRMPI(ierr);
306   ierr = MPI_Comm_rank(comm,&rank);CHKERRMPI(ierr);
307   rank_ = rank;
308 
309   ierr = MatCreate(comm,&A);CHKERRQ(ierr);
310   ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,size,size);CHKERRQ(ierr);
311   ierr = MatSetType(A,MATAIJ);CHKERRQ(ierr);
312   ierr = MatSeqAIJSetPreallocation(A,1,NULL);CHKERRQ(ierr);
313   ierr = MatMPIAIJSetPreallocation(A,n_,NULL,n_,NULL);CHKERRQ(ierr);
314   ierr = MatSetOption(A, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
315   /* Build original map */
316   ierr = PetscMalloc1(n_, &vals);CHKERRQ(ierr);
317   for (i = 0; i < n_; ++i) {
318     vals[i] = 1.0;
319   }
320   ierr = MatSetValues( A, 1,&rank_, n_,proc_neighbours_, vals, INSERT_VALUES);CHKERRQ(ierr);
321   ierr = MatAssemblyBegin(A,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
322   ierr = MatAssemblyEnd(A,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
323   /* Now force all other connections if they are not already there */
324   /* It's more efficient to do them all at once */
325   for (i = 0; i < n_; ++i) {
326     vals[i] = 2.0;
327   }
328   ierr = MatSetValues( A, n_,proc_neighbours_, 1,&rank_, vals, INSERT_VALUES);CHKERRQ(ierr);
329   ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
330   ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
331 /*
332   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
333   ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
334   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
335 */
336   if ((n_new != NULL) && (proc_neighbours_new != NULL)) {
337     ierr = MatGetRow(A, rank_, &nc, &cols, &red_vals);CHKERRQ(ierr);
338     _n_new = (PetscMPIInt) nc;
339     ierr = PetscMalloc1(_n_new, &_proc_neighbours_new);CHKERRQ(ierr);
340     for (j = 0; j < nc; ++j) {
341       _proc_neighbours_new[j] = (PetscMPIInt)cols[j];
342     }
343     ierr = MatRestoreRow( A, rank_, &nc, &cols, &red_vals);CHKERRQ(ierr);
344     *n_new               = (PetscMPIInt)_n_new;
345     *proc_neighbours_new = (PetscMPIInt*)_proc_neighbours_new;
346   }
347   ierr = MatDestroy(&A);CHKERRQ(ierr);
348   ierr = PetscFree(vals);CHKERRQ(ierr);
349   ierr = PetscFree(proc_neighbours_);CHKERRQ(ierr);
350   ierr = MPI_Barrier(comm);CHKERRMPI(ierr);
351   PetscFunctionReturn(0);
352 }
353 
354 PetscErrorCode DMSwarmDataExTopologyFinalize(DMSwarmDataEx d)
355 {
356   PetscMPIInt    symm_nn, *symm_procs, r0,n,st,rt, size;
357   PetscErrorCode ierr;
358 
359   PetscFunctionBegin;
360   PetscCheckFalse(d->topology_status != DEOBJECT_INITIALIZED,d->comm, PETSC_ERR_ARG_WRONGSTATE, "Topology must be initialised. Call DMSwarmDataExTopologyInitialize() first");
361 
362   ierr = PetscLogEventBegin(DMSWARM_DataExchangerTopologySetup,0,0,0,0);CHKERRQ(ierr);
363   /* given information about all my neighbours, make map symmetric */
364   ierr = _DMSwarmDataExCompleteCommunicationMap( d->comm,d->n_neighbour_procs,d->neighbour_procs, &symm_nn, &symm_procs);CHKERRQ(ierr);
365   /* update my arrays */
366   ierr = PetscFree(d->neighbour_procs);CHKERRQ(ierr);
367   d->n_neighbour_procs = symm_nn;
368   d->neighbour_procs   = symm_procs;
369   /* allocates memory */
370   if (!d->messages_to_be_sent) {ierr = PetscMalloc1(d->n_neighbour_procs+1, &d->messages_to_be_sent);CHKERRQ(ierr);}
371   if (!d->message_offsets) {ierr = PetscMalloc1(d->n_neighbour_procs+1, &d->message_offsets);CHKERRQ(ierr);}
372   if (!d->messages_to_be_recvieved) {ierr = PetscMalloc1(d->n_neighbour_procs+1, &d->messages_to_be_recvieved);CHKERRQ(ierr);}
373   if (!d->pack_cnt) {ierr = PetscMalloc(sizeof(PetscInt) * d->n_neighbour_procs, &d->pack_cnt);CHKERRQ(ierr);}
374   if (!d->_stats) {ierr = PetscMalloc(sizeof(MPI_Status) * 2*d->n_neighbour_procs, &d->_stats);CHKERRQ(ierr);}
375   if (!d->_requests) {ierr = PetscMalloc(sizeof(MPI_Request) * 2*d->n_neighbour_procs, &d->_requests);CHKERRQ(ierr);}
376   if (!d->send_tags) {ierr = PetscMalloc(sizeof(int) * d->n_neighbour_procs, &d->send_tags);CHKERRQ(ierr);}
377   if (!d->recv_tags) {ierr = PetscMalloc(sizeof(int) * d->n_neighbour_procs, &d->recv_tags);CHKERRQ(ierr);}
378   /* compute message tags */
379   ierr = MPI_Comm_size(d->comm,&size);CHKERRMPI(ierr);
380   r0 = d->rank;
381   for (n = 0; n < d->n_neighbour_procs; ++n) {
382     PetscMPIInt r1 = d->neighbour_procs[n];
383 
384     _get_tags( d->instance, size, 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   ierr = PetscLogEventEnd(DMSWARM_DataExchangerTopologySetup,0,0,0,0);CHKERRQ(ierr);
390   PetscFunctionReturn(0);
391 }
392 
393 /* === Phase B === */
394 PetscErrorCode _DMSwarmDataExConvertProcIdToLocalIndex(DMSwarmDataEx de,PetscMPIInt proc_id,PetscMPIInt *local)
395 {
396   PetscMPIInt i,np;
397 
398   PetscFunctionBegin;
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   PetscFunctionReturn(0);
408 }
409 
410 PetscErrorCode DMSwarmDataExInitializeSendCount(DMSwarmDataEx de)
411 {
412   PetscMPIInt    i;
413   PetscErrorCode ierr;
414 
415   PetscFunctionBegin;
416   PetscCheckFalse(de->topology_status != DEOBJECT_FINALIZED,de->comm, PETSC_ERR_ORDER, "Topology not finalized");
417   ierr = PetscLogEventBegin(DMSWARM_DataExchangerSendCount,0,0,0,0);CHKERRQ(ierr);
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   PetscFunctionReturn(0);
423 }
424 
425 /*
426 1) only allows counters to be set on neighbouring cpus
427 */
428 PetscErrorCode DMSwarmDataExAddToSendCount(DMSwarmDataEx de,const PetscMPIInt proc_id,const PetscInt count)
429 {
430   PetscMPIInt    local_val;
431   PetscErrorCode ierr;
432 
433   PetscFunctionBegin;
434   PetscCheckFalse(de->message_lengths_status == DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Message lengths have been defined. To modify these call DMSwarmDataExInitializeSendCount() first");
435   else PetscCheckFalse(de->message_lengths_status != DEOBJECT_INITIALIZED, de->comm, PETSC_ERR_ORDER, "Message lengths must be defined. Call DMSwarmDataExInitializeSendCount() first");
436 
437   ierr = _DMSwarmDataExConvertProcIdToLocalIndex( de, proc_id, &local_val);CHKERRQ(ierr);
438   PetscCheckFalse(local_val == -1, 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   PetscFunctionReturn(0);
442 }
443 
444 PetscErrorCode DMSwarmDataExFinalizeSendCount(DMSwarmDataEx de)
445 {
446   PetscErrorCode ierr;
447 
448   PetscFunctionBegin;
449   PetscCheckFalse(de->message_lengths_status != DEOBJECT_INITIALIZED, de->comm, PETSC_ERR_ORDER, "Message lengths must be defined. Call DMSwarmDataExInitializeSendCount() first");
450 
451   de->message_lengths_status = DEOBJECT_FINALIZED;
452   ierr = PetscLogEventEnd(DMSWARM_DataExchangerSendCount,0,0,0,0);CHKERRQ(ierr);
453   PetscFunctionReturn(0);
454 }
455 
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 _DMSwarmDataExInitializeTmpStorage(DMSwarmDataEx de)
465 {
466   PetscMPIInt    i, np;
467   PetscErrorCode ierr;
468 
469   PetscFunctionBegin;
470   np = de->n_neighbour_procs;
471   for (i = 0; i < np; ++i) {
472     /*  de->messages_to_be_sent[i] = -1; */
473     de->messages_to_be_recvieved[i] = -1;
474   }
475   ierr = PetscFree(de->send_message);CHKERRQ(ierr);
476   ierr = PetscFree(de->recv_message);CHKERRQ(ierr);
477   PetscFunctionReturn(0);
478 }
479 
480 /*
481    Zeros out pack data counters
482    Ensures mesaage length is set
483    Checks send counts properly initialized
484    allocates space for pack data
485 */
486 PetscErrorCode DMSwarmDataExPackInitialize(DMSwarmDataEx de,size_t unit_message_size)
487 {
488   PetscMPIInt    i,np;
489   PetscInt       total;
490   PetscErrorCode ierr;
491 
492   PetscFunctionBegin;
493   PetscCheckFalse(de->topology_status != DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Topology not finalized");
494   PetscCheckFalse(de->message_lengths_status != DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Message lengths not finalized");
495   ierr = PetscLogEventBegin(DMSWARM_DataExchangerPack,0,0,0,0);CHKERRQ(ierr);
496   de->packer_status = DEOBJECT_INITIALIZED;
497   ierr = _DMSwarmDataExInitializeTmpStorage(de);CHKERRQ(ierr);
498   np = de->n_neighbour_procs;
499   de->unit_message_size = unit_message_size;
500   total = 0;
501   for (i = 0; i < np; ++i) {
502     if (de->messages_to_be_sent[i] == -1) {
503       PetscMPIInt proc_neighour = de->neighbour_procs[i];
504       SETERRQ( PETSC_COMM_SELF, PETSC_ERR_ORDER, "Messages_to_be_sent[neighbour_proc=%d] is un-initialised. Call DMSwarmDataExSetSendCount() first", (int)proc_neighour);
505     }
506     total = total + de->messages_to_be_sent[i];
507   }
508   /* create space for the data to be sent */
509   ierr = PetscMalloc(unit_message_size * (total + 1), &de->send_message);CHKERRQ(ierr);
510   /* initialize memory */
511   ierr = PetscMemzero(de->send_message, unit_message_size * (total + 1));CHKERRQ(ierr);
512   /* set total items to send */
513   de->send_message_length = total;
514   de->message_offsets[0] = 0;
515   total = de->messages_to_be_sent[0];
516   for (i = 1; i < np; ++i) {
517     de->message_offsets[i] = total;
518     total = total + de->messages_to_be_sent[i];
519   }
520   /* init the packer counters */
521   de->total_pack_cnt = 0;
522   for (i = 0; i < np; ++i) {
523     de->pack_cnt[i] = 0;
524   }
525   PetscFunctionReturn(0);
526 }
527 
528 /*
529     Ensures data gets been packed appropriately and no overlaps occur
530 */
531 PetscErrorCode DMSwarmDataExPackData(DMSwarmDataEx de,PetscMPIInt proc_id,PetscInt n,void *data)
532 {
533   PetscMPIInt    local;
534   PetscInt       insert_location;
535   void           *dest;
536   PetscErrorCode ierr;
537 
538   PetscFunctionBegin;
539   PetscCheckFalse(de->packer_status == DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Packed data have been defined. To modify these call DMSwarmDataExInitializeSendCount(), DMSwarmDataExAddToSendCount(), DMSwarmDataExPackInitialize() first");
540   else PetscCheckFalse(de->packer_status != DEOBJECT_INITIALIZED, de->comm, PETSC_ERR_ORDER, "Packed data must be defined. Call DMSwarmDataExInitializeSendCount(), DMSwarmDataExAddToSendCount(), DMSwarmDataExPackInitialize() first");
541 
542   PetscCheckFalse(!de->send_message, de->comm, PETSC_ERR_ORDER, "send_message is not initialized. Call DMSwarmDataExPackInitialize() first");
543   ierr = _DMSwarmDataExConvertProcIdToLocalIndex( de, proc_id, &local);CHKERRQ(ierr);
544   PetscCheckFalse(local == -1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "proc_id %d is not registered neighbour", (int)proc_id);
545   PetscCheckFalse(n+de->pack_cnt[local] > de->messages_to_be_sent[local], 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",
546               (int)proc_id, de->messages_to_be_sent[local], n+de->pack_cnt[local]);
547 
548   /* copy memory */
549   insert_location = de->message_offsets[local] + de->pack_cnt[local];
550   dest = ((char*)de->send_message) + de->unit_message_size*insert_location;
551   ierr = PetscMemcpy(dest, data, de->unit_message_size * n);CHKERRQ(ierr);
552   /* increment counter */
553   de->pack_cnt[local] = de->pack_cnt[local] + n;
554   PetscFunctionReturn(0);
555 }
556 
557 /*
558 *) Ensures all data has been packed
559 */
560 PetscErrorCode DMSwarmDataExPackFinalize(DMSwarmDataEx de)
561 {
562   PetscMPIInt    i,np;
563   PetscInt       total;
564   PetscErrorCode ierr;
565 
566   PetscFunctionBegin;
567   PetscCheckFalse(de->packer_status != DEOBJECT_INITIALIZED, de->comm, PETSC_ERR_ORDER, "Packer has not been initialized. Must call DMSwarmDataExPackInitialize() first.");
568   np = de->n_neighbour_procs;
569   for (i = 0; i < np; ++i) {
570     PetscCheckFalse(de->pack_cnt[i] != de->messages_to_be_sent[i], PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Not all messages for neighbour[%d] have been packed. Expected %D : Inserted %D",
571                 (int)de->neighbour_procs[i], de->messages_to_be_sent[i], de->pack_cnt[i]);
572   }
573   /* init */
574   for (i = 0; i < np; ++i) {
575     de->messages_to_be_recvieved[i] = -1;
576   }
577   /* figure out the recv counts here */
578   for (i = 0; i < np; ++i) {
579     ierr = MPI_Isend(&de->messages_to_be_sent[i], 1, MPIU_INT, de->neighbour_procs[i], de->send_tags[i], de->comm, &de->_requests[i]);CHKERRMPI(ierr);
580   }
581   for (i = 0; i < np; ++i) {
582     ierr = 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]);CHKERRMPI(ierr);
583   }
584   ierr = MPI_Waitall(2*np, de->_requests, de->_stats);CHKERRMPI(ierr);
585   /* create space for the data to be recvieved */
586   total = 0;
587   for (i = 0; i < np; ++i) {
588     total = total + de->messages_to_be_recvieved[i];
589   }
590   ierr = PetscMalloc(de->unit_message_size * (total + 1), &de->recv_message);CHKERRQ(ierr);
591   /* initialize memory */
592   ierr = PetscMemzero(de->recv_message, de->unit_message_size * (total + 1));CHKERRQ(ierr);
593   /* set total items to receive */
594   de->recv_message_length = total;
595   de->packer_status = DEOBJECT_FINALIZED;
596   de->communication_status = DEOBJECT_INITIALIZED;
597   ierr = PetscLogEventEnd(DMSWARM_DataExchangerPack,0,0,0,0);CHKERRQ(ierr);
598   PetscFunctionReturn(0);
599 }
600 
601 /* do the actual message passing */
602 PetscErrorCode DMSwarmDataExBegin(DMSwarmDataEx de)
603 {
604   PetscMPIInt    i,np;
605   void           *dest;
606   PetscInt       length;
607   PetscErrorCode ierr;
608 
609   PetscFunctionBegin;
610   PetscCheckFalse(de->topology_status != DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Topology not finalized");
611   PetscCheckFalse(de->message_lengths_status != DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Message lengths not finalized");
612   PetscCheckFalse(de->packer_status != DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Packer not finalized");
613   PetscCheckFalse(de->communication_status == DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ORDER, "Communication has already been finalized. Must call DMSwarmDataExInitialize() first.");
614   PetscCheckFalse(!de->recv_message, de->comm, PETSC_ERR_ORDER, "recv_message has not been initialized. Must call DMSwarmDataExPackFinalize() first");
615   ierr = PetscLogEventBegin(DMSWARM_DataExchangerBegin,0,0,0,0);CHKERRQ(ierr);
616   np = de->n_neighbour_procs;
617   /* == NON BLOCKING == */
618   for (i = 0; i < np; ++i) {
619     length = de->messages_to_be_sent[i] * de->unit_message_size;
620     dest = ((char*)de->send_message) + de->unit_message_size * de->message_offsets[i];
621     ierr = MPI_Isend( dest, length, MPI_CHAR, de->neighbour_procs[i], de->send_tags[i], de->comm, &de->_requests[i]);CHKERRMPI(ierr);
622   }
623   ierr = PetscLogEventEnd(DMSWARM_DataExchangerBegin,0,0,0,0);CHKERRQ(ierr);
624   PetscFunctionReturn(0);
625 }
626 
627 /* do the actual message passing now */
628 PetscErrorCode DMSwarmDataExEnd(DMSwarmDataEx de)
629 {
630   PetscMPIInt    i,np;
631   PetscInt       total;
632   PetscInt       *message_recv_offsets;
633   void           *dest;
634   PetscInt       length;
635   PetscErrorCode ierr;
636 
637   PetscFunctionBegin;
638   PetscCheckFalse(de->communication_status != DEOBJECT_INITIALIZED, de->comm, PETSC_ERR_ORDER, "Communication has not been initialized. Must call DMSwarmDataExInitialize() first.");
639   PetscCheckFalse(!de->recv_message, de->comm, PETSC_ERR_ORDER, "recv_message has not been initialized. Must call DMSwarmDataExPackFinalize() first");
640   ierr = PetscLogEventBegin(DMSWARM_DataExchangerEnd,0,0,0,0);CHKERRQ(ierr);
641   np = de->n_neighbour_procs;
642   ierr = PetscMalloc1(np+1, &message_recv_offsets);CHKERRQ(ierr);
643   message_recv_offsets[0] = 0;
644   total = de->messages_to_be_recvieved[0];
645   for (i = 1; i < np; ++i) {
646     message_recv_offsets[i] = total;
647     total = total + de->messages_to_be_recvieved[i];
648   }
649   /* == NON BLOCKING == */
650   for (i = 0; i < np; ++i) {
651     length = de->messages_to_be_recvieved[i] * de->unit_message_size;
652     dest = ((char*)de->recv_message) + de->unit_message_size * message_recv_offsets[i];
653     ierr = MPI_Irecv( dest, length, MPI_CHAR, de->neighbour_procs[i], de->recv_tags[i], de->comm, &de->_requests[np+i]);CHKERRMPI(ierr);
654   }
655   ierr = MPI_Waitall( 2*np, de->_requests, de->_stats);CHKERRMPI(ierr);
656   ierr = PetscFree(message_recv_offsets);CHKERRQ(ierr);
657   de->communication_status = DEOBJECT_FINALIZED;
658   ierr = PetscLogEventEnd(DMSWARM_DataExchangerEnd,0,0,0,0);CHKERRQ(ierr);
659   PetscFunctionReturn(0);
660 }
661 
662 PetscErrorCode DMSwarmDataExGetSendData(DMSwarmDataEx de,PetscInt *length,void **send)
663 {
664   PetscFunctionBegin;
665   PetscCheckFalse(de->packer_status != DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ARG_WRONGSTATE, "Data has not finished being packed.");
666   *length = de->send_message_length;
667   *send   = de->send_message;
668   PetscFunctionReturn(0);
669 }
670 
671 PetscErrorCode DMSwarmDataExGetRecvData(DMSwarmDataEx de,PetscInt *length,void **recv)
672 {
673   PetscFunctionBegin;
674   PetscCheckFalse(de->communication_status != DEOBJECT_FINALIZED, de->comm, PETSC_ERR_ARG_WRONGSTATE, "Data has not finished being sent.");
675   *length = de->recv_message_length;
676   *recv   = de->recv_message;
677   PetscFunctionReturn(0);
678 }
679 
680 PetscErrorCode DMSwarmDataExTopologyGetNeighbours(DMSwarmDataEx de,PetscMPIInt *n,PetscMPIInt *neigh[])
681 {
682   PetscFunctionBegin;
683   if (n)     {*n     = de->n_neighbour_procs;}
684   if (neigh) {*neigh = de->neighbour_procs;}
685   PetscFunctionReturn(0);
686 }
687