Actual source code: mpi.c
1: /*
2: This provides a few of the MPI-uni functions that cannot be implemented
3: with C macros
4: */
5: #include <mpiuni/mpi.h>
7: #error "Wrong mpi.h included! require mpi.h from MPIUNI"
8: #endif
9: #if !defined(PETSC_STDCALL)
10: #define PETSC_STDCALL
11: #endif
12: #include <stdio.h>
13: #if defined(PETSC_HAVE_STDLIB_H)
14: #include <stdlib.h>
15: #endif
17: #define MPI_SUCCESS 0
18: #define MPI_FAILURE 1
19: void *MPIUNI_TMP = 0;
20: int MPIUNI_DATASIZE[10] = {sizeof(int),sizeof(float),sizeof(double),2*sizeof(double),sizeof(char),2*sizeof(int),4*sizeof(double),4,8,2*sizeof(double)};
21: /*
22: With MPI Uni there is only one communicator, which is called 1.
23: */
24: #define MAX_ATTR 128
26: typedef struct {
27: void *extra_state;
28: void *attribute_val;
29: int active;
30: MPI_Delete_function *del;
31: } MPI_Attr;
33: static MPI_Attr attr[MAX_ATTR];
34: static int num_attr = 1,mpi_tag_ub = 100000000;
36: #if defined(__cplusplus)
38: #endif
40: /*
41: To avoid problems with prototypes to the system memcpy() it is duplicated here
42: */
43: int MPIUNI_Memcpy(void *a,const void* b,int n) {
44: int i;
45: char *aa= (char*)a;
46: char *bb= (char*)b;
48: for (i=0; i<n; i++) aa[i] = bb[i];
49: return 0;
50: }
52: /*
53: Used to set the built-in MPI_TAG_UB attribute
54: */
55: static int Keyval_setup(void)
56: {
57: attr[0].active = 1;
58: attr[0].attribute_val = &mpi_tag_ub;
59: return 0;
60: }
62: int MPI_Keyval_create(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
63: {
64: if (num_attr >= MAX_ATTR) MPI_Abort(MPI_COMM_WORLD,1);
66: attr[num_attr].extra_state = extra_state;
67: attr[num_attr].del = delete_fn;
68: *keyval = num_attr++;
69: return 0;
70: }
72: int MPI_Keyval_free(int *keyval)
73: {
74: attr[*keyval].active = 0;
75: return MPI_SUCCESS;
76: }
78: int MPI_Attr_put(MPI_Comm comm,int keyval,void *attribute_val)
79: {
80: attr[keyval].active = 1;
81: attr[keyval].attribute_val = attribute_val;
82: return MPI_SUCCESS;
83: }
84:
85: int MPI_Attr_delete(MPI_Comm comm,int keyval)
86: {
87: if (attr[keyval].active && attr[keyval].del) {
88: void* save_attribute_val = attr[keyval].attribute_val;
89: attr[keyval].active = 0;
90: attr[keyval].attribute_val = 0;
91: (*(attr[keyval].del))(comm,keyval,save_attribute_val,attr[keyval].extra_state);
92: }
93: return MPI_SUCCESS;
94: }
96: int MPI_Attr_get(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
97: {
98: if (!keyval) Keyval_setup();
99: *flag = attr[keyval].active;
100: *(void **)attribute_val = attr[keyval].attribute_val;
101: return MPI_SUCCESS;
102: }
104: int MPI_Comm_create(MPI_Comm comm,MPI_Group group,MPI_Comm *newcomm)
105: {
106: *newcomm = comm;
107: return MPI_SUCCESS;
108: }
110: static int dups = 0;
111: int MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
112: {
113: *out = comm;
114: dups++;
115: return 0;
116: }
118: int MPI_Comm_free(MPI_Comm *comm)
119: {
120: int i;
122: if (--dups) return MPI_SUCCESS;
123: for (i=0; i<num_attr; i++) {
124: if (attr[i].active && attr[i].del) {
125: (*attr[i].del)(*comm,i,attr[i].attribute_val,attr[i].extra_state);
126: }
127: attr[i].active = 0;
128: }
129: return MPI_SUCCESS;
130: }
132: int MPI_Abort(MPI_Comm comm,int errorcode)
133: {
134: abort();
135: return MPI_SUCCESS;
136: }
138: /* --------------------------------------------------------------------------*/
139:
140: static int MPI_was_initialized = 0;
141: static int MPI_was_finalized = 0;
143: int MPI_Init(int *argc, char ***argv)
144: {
145: if (MPI_was_initialized) return 1;
146: if (MPI_was_finalized) return 1;
147: MPI_was_initialized = 1;
148: return 0;
149: }
151: int MPI_Finalize(void)
152: {
153: if (MPI_was_finalized) return 1;
154: if (!MPI_was_initialized) return 1;
155: MPI_was_finalized = 1;
156: return 0;
157: }
159: int MPI_Initialized(int *flag)
160: {
161: *flag = MPI_was_initialized;
162: return 0;
163: }
165: int MPI_Finalized(int *flag)
166: {
167: *flag = MPI_was_finalized;
168: return 0;
169: }
171: /* ------------------- Fortran versions of several routines ------------------ */
173: #if defined(PETSC_HAVE_FORTRAN_CAPS)
174: #define mpi_init_ MPI_INIT
175: #define mpi_finalize_ MPI_FINALIZE
176: #define mpi_comm_size_ MPI_COMM_SIZE
177: #define mpi_comm_rank_ MPI_COMM_RANK
178: #define mpi_abort_ MPI_ABORT
179: #define mpi_reduce_ MPI_REDUCE
180: #define mpi_allreduce_ MPI_ALLREDUCE
181: #define mpi_barrier_ MPI_BARRIER
182: #define mpi_bcast_ MPI_BCAST
183: #define mpi_gather_ MPI_GATHER
184: #define mpi_allgather_ MPI_ALLGATHER
185: #define mpi_comm_split_ MPI_COMM_SPLIT
186: #define mpi_scan_ MPI_SCAN
187: #define mpi_send_ MPI_SEND
188: #define mpi_recv_ MPI_RECV
189: #define mpi_reduce_scatter_ MPI_REDUCE_SCATTER
190: #define mpi_irecv_ MPI_IRECV
191: #define mpi_isend_ MPI_ISEND
192: #define mpi_sendrecv_ MPI_SENDRECV
193: #define mpi_test_ MPI_TEST
194: #define mpi_waitall_ MPI_WAITALL
195: #define mpi_waitany_ MPI_WAITANY
196: #define mpi_allgatherv_ MPI_ALLGATHERV
197: #define mpi_alltoallv_ MPI_ALLTOALLV
198: #define mpi_comm_create_ MPI_COMM_CREATE
199: #define mpi_address_ MPI_ADDRESS
200: #define mpi_pack_ MPI_PACK
201: #define mpi_unpack_ MPI_UNPACK
202: #define mpi_pack_size_ MPI_PACK_SIZE
203: #define mpi_type_struct_ MPI_TYPE_STRUCT
204: #define mpi_type_commit_ MPI_TYPE_COMMIT
205: #define mpi_wtime_ MPI_WTIME
206: #define mpi_cancel_ MPI_CANCEL
207: #define mpi_comm_dup_ MPI_COMM_DUP
208: #define mpi_comm_free_ MPI_COMM_FREE
209: #define mpi_get_count_ MPI_GET_COUNT
210: #define mpi_get_processor_name_ MPI_GET_PROCESSOR_NAME
211: #define mpi_initialized_ MPI_INITIALIZED
212: #define mpi_iprobe_ MPI_IPROBE
213: #define mpi_probe_ MPI_PROBE
214: #define mpi_request_free_ MPI_REQUEST_FREE
215: #define mpi_ssend_ MPI_SSEND
216: #define mpi_wait_ MPI_WAIT
217: #define mpi_comm_group_ MPI_COMM_GROUP
218: #define mpi_exscan_ MPI_EXSCAN
219: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
220: #define mpi_init_ mpi_init
221: #define mpi_finalize_ mpi_finalize
222: #define mpi_comm_size_ mpi_comm_size
223: #define mpi_comm_rank_ mpi_comm_rank
224: #define mpi_abort_ mpi_abort
225: #define mpi_reduce_ mpi_reduce
226: #define mpi_allreduce_ mpi_allreduce
227: #define mpi_barrier_ mpi_barrier
228: #define mpi_bcast_ mpi_bcast
229: #define mpi_gather_ mpi_gather
230: #define mpi_allgather_ mpi_allgather
231: #define mpi_comm_split_ mpi_comm_split
232: #define mpi_scan_ mpi_scan
233: #define mpi_send_ mpi_send
234: #define mpi_recv_ mpi_recv
235: #define mpi_reduce_scatter_ mpi_reduce_scatter
236: #define mpi_irecv_ mpi_irecv
237: #define mpi_isend_ mpi_isend
238: #define mpi_sendrecv_ mpi_sendrecv
239: #define mpi_test_ mpi_test
240: #define mpi_waitall_ mpi_waitall
241: #define mpi_waitany_ mpi_waitany
242: #define mpi_allgatherv_ mpi_allgatherv
243: #define mpi_alltoallv_ mpi_alltoallv
244: #define mpi_comm_create_ mpi_comm_create
245: #define mpi_address_ mpi_address
246: #define mpi_pack_ mpi_pack
247: #define mpi_unpack_ mpi_unpack
248: #define mpi_pack_size_ mpi_pack_size
249: #define mpi_type_struct_ mpi_type_struct
250: #define mpi_type_commit_ mpi_type_commit
251: #define mpi_wtime_ mpi_wtime
252: #define mpi_cancel_ mpi_cancel
253: #define mpi_comm_dup_ mpi_comm_dup
254: #define mpi_comm_free_ mpi_comm_free
255: #define mpi_get_count_ mpi_get_count
256: #define mpi_get_processor_name_ mpi_get_processor_name
257: #define mpi_initialized_ mpi_initialized
258: #define mpi_iprobe_ mpi_iprobe
259: #define mpi_probe_ mpi_probe
260: #define mpi_request_free_ mpi_request_free
261: #define mpi_ssend_ mpi_ssend
262: #define mpi_wait_ mpi_wait
263: #define mpi_comm_group_ mpi_comm_group
264: #define mpi_exscan_ mpi_exscan
265: #endif
267: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
268: #define mpi_init_ mpi_init__
269: #define mpi_finalize_ mpi_finalize__
270: #define mpi_comm_size_ mpi_comm_size__
271: #define mpi_comm_rank_ mpi_comm_rank__
272: #define mpi_abort_ mpi_abort__
273: #define mpi_reduce_ mpi_reduce__
274: #define mpi_allreduce_ mpi_allreduce__
275: #define mpi_barrier_ mpi_barrier__
276: #define mpi_bcast_ mpi_bcast__
277: #define mpi_gather_ mpi_gather__
278: #define mpi_allgather_ mpi_allgather__
279: #define mpi_comm_split_ mpi_comm_split__
280: #define mpi_scan_ mpi_scan__
281: #define mpi_send_ mpi_send__
282: #define mpi_recv_ mpi_recv__
283: #define mpi_reduce_scatter_ mpi_reduce_scatter__
284: #define mpi_irecv_ mpi_irecv__
285: #define mpi_isend_ mpi_isend__
286: #define mpi_sendrecv_ mpi_sendrecv__
287: #define mpi_test_ mpi_test__
288: #define mpi_waitall_ mpi_waitall__
289: #define mpi_waitany_ mpi_waitany__
290: #define mpi_allgatherv_ mpi_allgatherv__
291: #define mpi_alltoallv_ mpi_alltoallv__
292: #define mpi_comm_create_ mpi_comm_create__
293: #define mpi_address_ mpi_address__
294: #define mpi_pack_ mpi_pack__
295: #define mpi_unpack_ mpi_unpack__
296: #define mpi_pack_size_ mpi_pack_size__
297: #define mpi_type_struct_ mpi_type_struct__
298: #define mpi_type_commit_ mpi_type_commit__
299: #define mpi_wtime_ mpi_wtime__
300: #define mpi_cancel_ mpi_cancel__
301: #define mpi_comm_dup_ mpi_comm_dup__
302: #define mpi_comm_free_ mpi_comm_free__
303: #define mpi_get_count_ mpi_get_count__
304: #define mpi_get_processor_name_ mpi_get_processor_name__
305: #define mpi_initialized_ mpi_initialized__
306: #define mpi_iprobe_ mpi_iprobe__
307: #define mpi_probe_ mpi_probe__
308: #define mpi_request_free_ mpi_request_free__
309: #define mpi_ssend_ mpi_ssend__
310: #define mpi_wait_ mpi_wait__
311: #define mpi_comm_group_ mpi_comm_group__
312: #define mpi_exscan_ mpi_exscan__
313: #endif
316: /* Do not build fortran interface if MPI namespace colision is to be avoided */
317: #if !defined(MPIUNI_AVOID_MPI_NAMESPACE)
319: void PETSC_STDCALL mpi_init_(int *ierr)
320: {
321: *MPI_Init((int*)0, (char***)0);
322: }
324: void PETSC_STDCALL mpi_finalize_(int *ierr)
325: {
326: *MPI_Finalize();
327: }
329: void PETSC_STDCALL mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
330: {
331: *size = 1;
332: *0;
333: }
335: void PETSC_STDCALL mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
336: {
337: *rank=0;
338: *ierr=MPI_SUCCESS;
339: }
341: void PETSC_STDCALL mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr)
342: {
343: *newcomm = *comm;
344: *ierr=MPI_SUCCESS;
345: }
347: void PETSC_STDCALL mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
348: {
349: abort();
350: *MPI_SUCCESS;
351: }
353: void PETSC_STDCALL mpi_reduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *root,int *comm,int *ierr)
354: {
355: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
356: *MPI_SUCCESS;
357: }
359: void PETSC_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
360: {
361: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
362: *MPI_SUCCESS;
363: }
365: void PETSC_STDCALL mpi_barrier_(MPI_Comm *comm,int *ierr)
366: {
367: *MPI_SUCCESS;
368: }
370: void PETSC_STDCALL mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr)
371: {
372: *MPI_SUCCESS;
373: }
376: void PETSC_STDCALL mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype, int *root,int *comm,int *ierr)
377: {
378: MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]);
379: *MPI_SUCCESS;
380: }
382: void PETSC_STDCALL mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype,int *comm,int *ierr)
383: {
384: MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]);
385: *MPI_SUCCESS;
386: }
388: void PETSC_STDCALL mpi_scan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
389: {
390: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
391: *MPI_SUCCESS;
392: }
394: void PETSC_STDCALL mpi_send_(void*buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr )
395: {
396: *MPI_Abort(MPI_COMM_WORLD,0);
397: }
399: void PETSC_STDCALL mpi_recv_(void*buf,int *count,int *datatype,int *source,int *tag,int *comm,int status,int *ierr )
400: {
401: *MPI_Abort(MPI_COMM_WORLD,0);
402: }
404: void PETSC_STDCALL mpi_reduce_scatter_(void*sendbuf,void*recvbuf,int *recvcounts,int *datatype,int *op,int *comm,int *ierr)
405: {
406: *MPI_Abort(MPI_COMM_WORLD,0);
407: }
409: void PETSC_STDCALL mpi_irecv_(void*buf,int *count, int *datatype, int *source, int *tag, int *comm, int *request, int *ierr)
410: {
411: *MPI_Abort(MPI_COMM_WORLD,0);
412: }
414: void PETSC_STDCALL mpi_isend_(void*buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *request, int *ierr)
415: {
416: *MPI_Abort(MPI_COMM_WORLD,0);
417: }
419: void PETSC_STDCALL mpi_sendrecv_(void*sendbuf,int *sendcount,int *sendtype,int *dest,int *sendtag,void*recvbuf,int *recvcount,int *recvtype,int *source,int *recvtag,int *comm,int *status,int *ierr)
420: {
421: MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPIUNI_DATASIZE[*sendtype]);
422: *MPI_SUCCESS;
423: }
425: void PETSC_STDCALL mpi_test_(int *request,int *flag,int *status,int *ierr)
426: {
427: *MPI_Abort(MPI_COMM_WORLD,0);
428: }
430: void PETSC_STDCALL mpi_waitall_(int *count,int *array_of_requests,int *array_of_statuses,int *ierr)
431: {
432: *MPI_SUCCESS;
433: }
435: void PETSC_STDCALL mpi_waitany_(int *count,int *array_of_requests,int * index, int *status,int *ierr)
436: {
437: *MPI_SUCCESS;
438: }
440: void PETSC_STDCALL mpi_allgatherv_(void*sendbuf,int *sendcount,int *sendtype,void*recvbuf,int *recvcounts,int *displs,int *recvtype,int *comm,int *ierr)
441: {
442: MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPIUNI_DATASIZE[*sendtype]);
443: *MPI_SUCCESS;
444: }
446: void PETSC_STDCALL mpi_alltoallv_(void*sendbuf,int *sendcounts,int *sdispls,int *sendtype,void*recvbuf,int *recvcounts,int *rdispls,int *recvtype,int *comm,int *ierr)
447: {
448: MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcounts)*MPIUNI_DATASIZE[*sendtype]);
449: *MPI_SUCCESS;
450: }
452: void PETSC_STDCALL mpi_comm_create_(int *comm,int *group,int *newcomm,int *ierr)
453: {
454: *newcomm = *comm;
455: *MPI_SUCCESS;
456: }
458: void PETSC_STDCALL mpi_address_(void*location,MPIUNI_INTPTR *address,int *ierr)
459: {
460: *address = (MPIUNI_INTPTR) location;
461: *MPI_SUCCESS;
462: }
464: void PETSC_STDCALL mpi_pack_(void*inbuf,int *incount,int *datatype,void*outbuf,int *outsize,int *position,int *comm,int *ierr)
465: {
466: *MPI_Abort(MPI_COMM_WORLD,0);
467: }
469: void PETSC_STDCALL mpi_unpack_(void*inbuf,int *insize,int *position,void*outbuf,int *outcount,int *datatype,int *comm,int *ierr)
470: {
471: *MPI_Abort(MPI_COMM_WORLD,0);
472: }
474: void PETSC_STDCALL mpi_pack_size_(int *incount,int *datatype,int *comm,int *size,int *ierr)
475: {
476: *MPI_Abort(MPI_COMM_WORLD,0);
477: }
479: void PETSC_STDCALL mpi_type_struct_(int *count,int *array_of_blocklengths,int * array_of_displaments,int *array_of_types,int *newtype,int *ierr)
480: {
481: *MPI_Abort(MPI_COMM_WORLD,0);
482: }
484: void PETSC_STDCALL mpi_type_commit_(int *datatype,int *ierr)
485: {
486: *MPI_SUCCESS;
487: }
489: double PETSC_STDCALL mpi_wtime_(void)
490: {
491: return 0.0;
492: }
494: void PETSC_STDCALL mpi_cancel_(int *request,int *ierr)
495: {
496: *MPI_SUCCESS;
497: }
499: void PETSC_STDCALL mpi_comm_dup_(int *comm,int *out,int *ierr)
500: {
501: *out = *comm;
502: *MPI_SUCCESS;
503: }
505: void PETSC_STDCALL mpi_comm_free_(int *comm,int *ierr)
506: {
507: *MPI_SUCCESS;
508: }
510: void PETSC_STDCALL mpi_get_count_(int *status,int *datatype,int *count,int *ierr)
511: {
512: *MPI_Abort(MPI_COMM_WORLD,0);
513: }
515: /* duplicate from fortranimpl.h */
516: #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
517: #define PETSC_MIXED_LEN(len) ,int len
518: #define PETSC_END_LEN(len)
519: #else
520: #define PETSC_MIXED_LEN(len)
521: #define PETSC_END_LEN(len) ,int len
522: #endif
524: void PETSC_STDCALL mpi_get_processor_name_(char *name PETSC_MIXED_LEN(len),int *result_len,int *ierr PETSC_END_LEN(len))
525: {
526: MPIUNI_Memcpy(name,"localhost",9*sizeof(char));
527: *result_len = 9;
528: *MPI_SUCCESS;
529: }
531: void PETSC_STDCALL mpi_initialized_(int *flag,int *ierr)
532: {
533: *flag = MPI_was_initialized;
534: *MPI_SUCCESS;
535: }
537: void PETSC_STDCALL mpi_iprobe_(int *source,int *tag,int *comm,int *glag,int *status,int *ierr)
538: {
539: *MPI_SUCCESS;
540: }
542: void PETSC_STDCALL mpi_probe_(int *source,int *tag,int *comm,int *flag,int *status,int *ierr)
543: {
544: *MPI_SUCCESS;
545: }
547: void PETSC_STDCALL mpi_request_free_(int *request,int *ierr)
548: {
549: *MPI_SUCCESS;
550: }
552: void PETSC_STDCALL mpi_ssend_(void*buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
553: {
554: *MPI_Abort(MPI_COMM_WORLD,0);
555: }
557: void PETSC_STDCALL mpi_wait_(int *request,int *status,int *ierr)
558: {
559: *MPI_SUCCESS;
560: }
562: void PETSC_STDCALL mpi_comm_group_(int*comm,int*group,int *ierr)
563: {
564: *MPI_SUCCESS;
565: }
567: void PETSC_STDCALL mpi_exscan_(void*sendbuf,void*recvbuf,int*count,int*datatype,int*op,int*comm,int*ierr)
568: {
569: *MPI_SUCCESS;
570: }
572: #endif /* MPIUNI_AVOID_MPI_NAMESPACE */
574: #if defined(__cplusplus)
575: }
576: #endif