Actual source code: mpi.c
petsc-3.10.5 2019-03-28
1: /*
2: This provides a few of the MPI-uni functions that cannot be implemented
3: with C macros
4: */
5: #include <petscsys.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
13: #define MPI_SUCCESS 0
14: #define MPI_FAILURE 1
16: void *MPIUNI_TMP = NULL;
18: /*
19: With MPI Uni there are exactly four distinct communicators:
20: MPI_COMM_SELF, MPI_COMM_WORLD, and a MPI_Comm_dup() of each of these (duplicates of duplicates return the same communictor)
22: MPI_COMM_SELF and MPI_COMM_WORLD are MPI_Comm_free() in MPI_Finalize() but in general with PETSc,
23: the other communicators are freed once the last PETSc object is freed (before MPI_Finalize()).
25: */
26: #define MAX_ATTR 128
27: #define MAX_COMM 128
29: static int MaxComm = 2;
31: typedef struct {
32: void *attribute_val;
33: int active;
34: } MPI_Attr;
36: typedef struct {
37: void *extra_state;
38: MPI_Delete_function *del;
39: } MPI_Attr_keyval;
41: static MPI_Attr_keyval attr_keyval[MAX_ATTR];
42: static MPI_Attr attr[MAX_COMM][MAX_ATTR];
43: static int comm_active[MAX_COMM];
44: static int num_attr = 1,mpi_tag_ub = 100000000;
45: static void* MPIUNIF_mpi_in_place = 0;
47: #if defined(__cplusplus)
48: extern "C" {
49: #endif
51: /*
52: To avoid problems with prototypes to the system memcpy() it is duplicated here
53: */
54: int MPIUNI_Memcpy(void *a,const void *b,int n)
55: {
56: int i;
57: char *aa= (char*)a;
58: char *bb= (char*)b;
60: if (a == MPI_IN_PLACE || a == MPIUNIF_mpi_in_place) return MPI_SUCCESS;
61: if (b == MPI_IN_PLACE || b == MPIUNIF_mpi_in_place) return MPI_SUCCESS;
62: for (i=0; i<n; i++) aa[i] = bb[i];
63: return MPI_SUCCESS;
64: }
66: static int classcnt = 0;
67: static int codecnt = 0;
69: int MPI_Add_error_class(int *cl)
70: {
71: *cl = classcnt++;
72: return MPI_SUCCESS;
73: }
75: int MPI_Add_error_code(int cl,int *co)
76: {
77: if (cl >= classcnt) return MPI_FAILURE;
78: *co = codecnt++;
79: return MPI_SUCCESS;
80: }
82: int MPI_Type_get_envelope(MPI_Datatype datatype,int *num_integers,int *num_addresses,int *num_datatypes,int *combiner)
83: {
84: int comb = datatype >> 28;
85: switch (comb) {
86: case MPI_COMBINER_NAMED:
87: *num_integers = 0;
88: *num_addresses = 0;
89: *num_datatypes = 0;
90: *combiner = comb;
91: break;
92: case MPI_COMBINER_DUP:
93: *num_integers = 0;
94: *num_addresses = 0;
95: *num_datatypes = 1;
96: *combiner = comb;
97: break;
98: case MPI_COMBINER_CONTIGUOUS:
99: *num_integers = 1;
100: *num_addresses = 0;
101: *num_datatypes = 1;
102: *combiner = comb;
103: break;
104: default:
105: return MPIUni_Abort(MPI_COMM_SELF,1);
106: }
107: return MPI_SUCCESS;
108: }
110: int MPI_Type_get_contents(MPI_Datatype datatype,int max_integers,int max_addresses,int max_datatypes,int *array_of_integers,MPI_Aint *array_of_addresses,MPI_Datatype *array_of_datatypes)
111: {
112: int comb = datatype >> 28;
113: switch (comb) {
114: case MPI_COMBINER_NAMED:
115: return MPIUni_Abort(MPI_COMM_SELF,1);
116: break;
117: case MPI_COMBINER_DUP:
118: if (max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1);
119: array_of_datatypes[0] = datatype & 0x0fffffff;
120: break;
121: case MPI_COMBINER_CONTIGUOUS:
122: if (max_integers < 1 || max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1);
123: array_of_integers[0] = (datatype >> 8) & 0xfff; /* count */
124: array_of_datatypes[0] = (datatype & 0x0ff000ff) | 0x100; /* basic named type (count=1) from which the contiguous type is derived */
125: break;
126: default:
127: return MPIUni_Abort(MPI_COMM_SELF,1);
128: }
129: return MPI_SUCCESS;
130: }
132: /*
133: Used to set the built-in MPI_TAG_UB attribute
134: */
135: static int Keyval_setup(void)
136: {
137: attr[MPI_COMM_WORLD-1][0].active = 1;
138: attr[MPI_COMM_WORLD-1][0].attribute_val = &mpi_tag_ub;
139: attr[MPI_COMM_SELF-1][0].active = 1;
140: attr[MPI_COMM_SELF-1][0].attribute_val = &mpi_tag_ub;
141: return MPI_SUCCESS;
142: }
144: int MPI_Comm_create_keyval(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
145: {
146: if (num_attr >= MAX_ATTR) return MPIUni_Abort(MPI_COMM_WORLD,1);
148: attr_keyval[num_attr].extra_state = extra_state;
149: attr_keyval[num_attr].del = delete_fn;
150: *keyval = num_attr++;
151: return MPI_SUCCESS;
152: }
154: int MPI_Comm_free_keyval(int *keyval)
155: {
156: attr_keyval[*keyval].extra_state = 0;
157: attr_keyval[*keyval].del = 0;
159: *keyval = 0;
160: return MPI_SUCCESS;
161: }
163: int MPI_Comm_set_attr(MPI_Comm comm,int keyval,void *attribute_val)
164: {
165: if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
166: attr[comm-1][keyval].active = 1;
167: attr[comm-1][keyval].attribute_val = attribute_val;
168: return MPI_SUCCESS;
169: }
171: int MPI_Comm_delete_attr(MPI_Comm comm,int keyval)
172: {
173: if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
174: if (attr[comm-1][keyval].active && attr_keyval[keyval].del) {
175: void *save_attribute_val = attr[comm-1][keyval].attribute_val;
176: attr[comm-1][keyval].active = 0;
177: attr[comm-1][keyval].attribute_val = 0;
178: (*(attr_keyval[keyval].del))(comm,keyval,save_attribute_val,attr_keyval[keyval].extra_state);
179: }
180: return MPI_SUCCESS;
181: }
183: int MPI_Comm_get_attr(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
184: {
185: if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
186: if (!keyval) Keyval_setup();
187: *flag = attr[comm-1][keyval].active;
188: *(void**)attribute_val = attr[comm-1][keyval].attribute_val;
189: return MPI_SUCCESS;
190: }
192: int MPI_Comm_create(MPI_Comm comm,MPI_Group group,MPI_Comm *newcomm)
193: {
194: int j;
195: if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
196: for (j=3; j<MaxComm; j++) {
197: if (!comm_active[j-1]) {
198: comm_active[j-1] = 1;
199: *newcomm = j;
200: return MPI_SUCCESS;
201: }
202: }
203: if (MaxComm > MAX_COMM) return MPI_FAILURE;
204: *newcomm = MaxComm++;
205: comm_active[*newcomm-1] = 1;
206: return MPI_SUCCESS;
207: }
209: int MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
210: {
211: int j;
212: if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
213: for (j=3; j<MaxComm; j++) {
214: if (!comm_active[j-1]) {
215: comm_active[j-1] = 1;
216: *out = j;
217: return MPI_SUCCESS;
218: }
219: }
220: if (MaxComm > MAX_COMM) return MPI_FAILURE;
221: *out = MaxComm++;
222: comm_active[*out-1] = 1;
223: return MPI_SUCCESS;
224: }
226: int MPI_Comm_free(MPI_Comm *comm)
227: {
228: int i;
230: if (*comm-1 < 0 || *comm-1 > MaxComm) return MPI_FAILURE;
231: for (i=0; i<num_attr; i++) {
232: if (attr[*comm-1][i].active && attr_keyval[i].del) (*attr_keyval[i].del)(*comm,i,attr[*comm-1][i].attribute_val,attr_keyval[i].extra_state);
233: attr[*comm-1][i].active = 0;
234: attr[*comm-1][i].attribute_val = 0;
235: }
236: if (*comm >= 3) comm_active[*comm-1] = 0;
237: *comm = 0;
238: return MPI_SUCCESS;
239: }
241: int MPI_Comm_size(MPI_Comm comm, int *size)
242: {
243: if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
244: *size=1;
245: return MPI_SUCCESS;
246: }
248: int MPI_Comm_rank(MPI_Comm comm, int *rank)
249: {
250: if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
251: *rank=0;
252: return MPI_SUCCESS;
253: }
255: int MPIUni_Abort(MPI_Comm comm,int errorcode)
256: {
257: printf("MPI operation not supported by PETSc's sequential MPI wrappers\n");
258: return MPI_FAILURE;
259: }
261: int MPI_Abort(MPI_Comm comm,int errorcode)
262: {
263: abort();
264: return MPI_SUCCESS;
265: }
267: /* --------------------------------------------------------------------------*/
269: static int MPI_was_initialized = 0;
270: static int MPI_was_finalized = 0;
272: int MPI_Init(int *argc, char ***argv)
273: {
274: if (MPI_was_initialized) return MPI_FAILURE;
275: if (MPI_was_finalized) return MPI_FAILURE;
276: MPI_was_initialized = 1;
277: return MPI_SUCCESS;
278: }
280: int MPI_Finalize(void)
281: {
282: MPI_Comm comm;
283: if (MPI_was_finalized) return MPI_FAILURE;
284: if (!MPI_was_initialized) return MPI_FAILURE;
285: comm = MPI_COMM_WORLD;
286: MPI_Comm_free(&comm);
287: comm = MPI_COMM_SELF;
288: MPI_Comm_free(&comm);
289: MPI_was_finalized = 1;
290: return MPI_SUCCESS;
291: }
293: int MPI_Initialized(int *flag)
294: {
295: *flag = MPI_was_initialized;
296: return MPI_SUCCESS;
297: }
299: int MPI_Finalized(int *flag)
300: {
301: *flag = MPI_was_finalized;
302: return MPI_SUCCESS;
303: }
305: /* ------------------- Fortran versions of several routines ------------------ */
307: #if defined(PETSC_HAVE_FORTRAN_CAPS)
308: #define mpiunisetmoduleblock_ MPIUNISETMODULEBLOCK
309: #define mpiunisetfortranbasepointers_ MPIUNISETFORTRANBASEPOINTERS
310: #define petsc_mpi_init_ PETSC_MPI_INIT
311: #define petsc_mpi_finalize_ PETSC_MPI_FINALIZE
312: #define petsc_mpi_comm_size_ PETSC_MPI_COMM_SIZE
313: #define petsc_mpi_comm_rank_ PETSC_MPI_COMM_RANK
314: #define petsc_mpi_abort_ PETSC_MPI_ABORT
315: #define petsc_mpi_reduce_ PETSC_MPI_REDUCE
316: #define petsc_mpi_allreduce_ PETSC_MPI_ALLREDUCE
317: #define petsc_mpi_barrier_ PETSC_MPI_BARRIER
318: #define petsc_mpi_bcast_ PETSC_MPI_BCAST
319: #define petsc_mpi_gather_ PETSC_MPI_GATHER
320: #define petsc_mpi_allgather_ PETSC_MPI_ALLGATHER
321: #define petsc_mpi_comm_split_ PETSC_MPI_COMM_SPLIT
322: #define petsc_mpi_scan_ PETSC_MPI_SCAN
323: #define petsc_mpi_send_ PETSC_MPI_SEND
324: #define petsc_mpi_recv_ PETSC_MPI_RECV
325: #define petsc_mpi_reduce_scatter_ PETSC_MPI_REDUCE_SCATTER
326: #define petsc_mpi_irecv_ PETSC_MPI_IRECV
327: #define petsc_mpi_isend_ PETSC_MPI_ISEND
328: #define petsc_mpi_sendrecv_ PETSC_MPI_SENDRECV
329: #define petsc_mpi_test_ PETSC_MPI_TEST
330: #define petsc_mpi_waitall_ PETSC_MPI_WAITALL
331: #define petsc_mpi_waitany_ PETSC_MPI_WAITANY
332: #define petsc_mpi_allgatherv_ PETSC_MPI_ALLGATHERV
333: #define petsc_mpi_alltoallv_ PETSC_MPI_ALLTOALLV
334: #define petsc_mpi_comm_create_ PETSC_MPI_COMM_CREATE
335: #define petsc_mpi_address_ PETSC_MPI_ADDRESS
336: #define petsc_mpi_pack_ PETSC_MPI_PACK
337: #define petsc_mpi_unpack_ PETSC_MPI_UNPACK
338: #define petsc_mpi_pack_size_ PETSC_MPI_PACK_SIZE
339: #define petsc_mpi_type_struct_ PETSC_MPI_TYPE_STRUCT
340: #define petsc_mpi_type_commit_ PETSC_MPI_TYPE_COMMIT
341: #define petsc_mpi_wtime_ PETSC_MPI_WTIME
342: #define petsc_mpi_cancel_ PETSC_MPI_CANCEL
343: #define petsc_mpi_comm_dup_ PETSC_MPI_COMM_DUP
344: #define petsc_mpi_comm_free_ PETSC_MPI_COMM_FREE
345: #define petsc_mpi_get_count_ PETSC_MPI_GET_COUNT
346: #define petsc_mpi_get_processor_name_ PETSC_MPI_GET_PROCESSOR_NAME
347: #define petsc_mpi_initialized_ PETSC_MPI_INITIALIZED
348: #define petsc_mpi_iprobe_ PETSC_MPI_IPROBE
349: #define petsc_mpi_probe_ PETSC_MPI_PROBE
350: #define petsc_mpi_request_free_ PETSC_MPI_REQUEST_FREE
351: #define petsc_mpi_ssend_ PETSC_MPI_SSEND
352: #define petsc_mpi_wait_ PETSC_MPI_WAIT
353: #define petsc_mpi_comm_group_ PETSC_MPI_COMM_GROUP
354: #define petsc_mpi_exscan_ PETSC_MPI_EXSCAN
355: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
356: #define mpiunisetmoduleblock_ mpiunisetmoduleblock
357: #define mpiunisetfortranbasepointers_ mpiunisetfortranbasepointers
358: #define petsc_mpi_init_ petsc_mpi_init
359: #define petsc_mpi_finalize_ petsc_mpi_finalize
360: #define petsc_mpi_comm_size_ petsc_mpi_comm_size
361: #define petsc_mpi_comm_rank_ petsc_mpi_comm_rank
362: #define petsc_mpi_abort_ petsc_mpi_abort
363: #define petsc_mpi_reduce_ petsc_mpi_reduce
364: #define petsc_mpi_allreduce_ petsc_mpi_allreduce
365: #define petsc_mpi_barrier_ petsc_mpi_barrier
366: #define petsc_mpi_bcast_ petsc_mpi_bcast
367: #define petsc_mpi_gather_ petsc_mpi_gather
368: #define petsc_mpi_allgather_ petsc_mpi_allgather
369: #define petsc_mpi_comm_split_ petsc_mpi_comm_split
370: #define petsc_mpi_scan_ petsc_mpi_scan
371: #define petsc_mpi_send_ petsc_mpi_send
372: #define petsc_mpi_recv_ petsc_mpi_recv
373: #define petsc_mpi_reduce_scatter_ petsc_mpi_reduce_scatter
374: #define petsc_mpi_irecv_ petsc_mpi_irecv
375: #define petsc_mpi_isend_ petsc_mpi_isend
376: #define petsc_mpi_sendrecv_ petsc_mpi_sendrecv
377: #define petsc_mpi_test_ petsc_mpi_test
378: #define petsc_mpi_waitall_ petsc_mpi_waitall
379: #define petsc_mpi_waitany_ petsc_mpi_waitany
380: #define petsc_mpi_allgatherv_ petsc_mpi_allgatherv
381: #define petsc_mpi_alltoallv_ petsc_mpi_alltoallv
382: #define petsc_mpi_comm_create_ petsc_mpi_comm_create
383: #define petsc_mpi_address_ petsc_mpi_address
384: #define petsc_mpi_pack_ petsc_mpi_pack
385: #define petsc_mpi_unpack_ petsc_mpi_unpack
386: #define petsc_mpi_pack_size_ petsc_mpi_pack_size
387: #define petsc_mpi_type_struct_ petsc_mpi_type_struct
388: #define petsc_mpi_type_commit_ petsc_mpi_type_commit
389: #define petsc_mpi_wtime_ petsc_mpi_wtime
390: #define petsc_mpi_cancel_ petsc_mpi_cancel
391: #define petsc_mpi_comm_dup_ petsc_mpi_comm_dup
392: #define petsc_mpi_comm_free_ petsc_mpi_comm_free
393: #define petsc_mpi_get_count_ petsc_mpi_get_count
394: #define petsc_mpi_get_processor_name_ petsc_mpi_get_processor_name
395: #define petsc_mpi_initialized_ petsc_mpi_initialized
396: #define petsc_mpi_iprobe_ petsc_mpi_iprobe
397: #define petsc_mpi_probe_ petsc_mpi_probe
398: #define petsc_mpi_request_free_ petsc_mpi_request_free
399: #define petsc_mpi_ssend_ petsc_mpi_ssend
400: #define petsc_mpi_wait_ petsc_mpi_wait
401: #define petsc_mpi_comm_group_ petsc_mpi_comm_group
402: #define petsc_mpi_exscan_ petsc_mpi_exscan
403: #endif
405: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
406: #define petsc_mpi_init_ petsc_mpi_init__
407: #define petsc_mpi_finalize_ petsc_mpi_finalize__
408: #define petsc_mpi_comm_size_ petsc_mpi_comm_size__
409: #define petsc_mpi_comm_rank_ petsc_mpi_comm_rank__
410: #define petsc_mpi_abort_ petsc_mpi_abort__
411: #define petsc_mpi_reduce_ petsc_mpi_reduce__
412: #define petsc_mpi_allreduce_ petsc_mpi_allreduce__
413: #define petsc_mpi_barrier_ petsc_mpi_barrier__
414: #define petsc_mpi_bcast_ petsc_mpi_bcast__
415: #define petsc_mpi_gather_ petsc_mpi_gather__
416: #define petsc_mpi_allgather_ petsc_mpi_allgather__
417: #define petsc_mpi_comm_split_ petsc_mpi_comm_split__
418: #define petsc_mpi_scan_ petsc_mpi_scan__
419: #define petsc_mpi_send_ petsc_mpi_send__
420: #define petsc_mpi_recv_ petsc_mpi_recv__
421: #define petsc_mpi_reduce_scatter_ petsc_mpi_reduce_scatter__
422: #define petsc_mpi_irecv_ petsc_mpi_irecv__
423: #define petsc_mpi_isend_ petsc_mpi_isend__
424: #define petsc_mpi_sendrecv_ petsc_mpi_sendrecv__
425: #define petsc_mpi_test_ petsc_mpi_test__
426: #define petsc_mpi_waitall_ petsc_mpi_waitall__
427: #define petsc_mpi_waitany_ petsc_mpi_waitany__
428: #define petsc_mpi_allgatherv_ petsc_mpi_allgatherv__
429: #define petsc_mpi_alltoallv_ petsc_mpi_alltoallv__
430: #define petsc_mpi_comm_create_ petsc_mpi_comm_create__
431: #define petsc_mpi_address_ petsc_mpi_address__
432: #define petsc_mpi_pack_ petsc_mpi_pack__
433: #define petsc_mpi_unpack_ petsc_mpi_unpack__
434: #define petsc_mpi_pack_size_ petsc_mpi_pack_size__
435: #define petsc_mpi_type_struct_ petsc_mpi_type_struct__
436: #define petsc_mpi_type_commit_ petsc_mpi_type_commit__
437: #define petsc_mpi_wtime_ petsc_mpi_wtime__
438: #define petsc_mpi_cancel_ petsc_mpi_cancel__
439: #define petsc_mpi_comm_dup_ petsc_mpi_comm_dup__
440: #define petsc_mpi_comm_free_ petsc_mpi_comm_free__
441: #define petsc_mpi_get_count_ petsc_mpi_get_count__
442: #define petsc_mpi_get_processor_name_ petsc_mpi_get_processor_name__
443: #define petsc_mpi_initialized_ petsc_mpi_initialized__
444: #define petsc_mpi_iprobe_ petsc_mpi_iprobe__
445: #define petsc_mpi_probe_ petsc_mpi_probe__
446: #define petsc_mpi_request_free_ petsc_mpi_request_free__
447: #define petsc_mpi_ssend_ petsc_mpi_ssend__
448: #define petsc_mpi_wait_ petsc_mpi_wait__
449: #define petsc_mpi_comm_group_ petsc_mpi_comm_group__
450: #define petsc_mpi_exscan_ petsc_mpi_exscan__
451: #endif
453: /* Do not build fortran interface if MPI namespace colision is to be avoided */
454: #if defined(PETSC_HAVE_FORTRAN)
456: PETSC_EXTERN void PETSC_STDCALL mpiunisetmoduleblock_(void);
458: PETSC_EXTERN void PETSC_STDCALL mpiunisetfortranbasepointers_(void *f_mpi_in_place)
459: {
460: MPIUNIF_mpi_in_place = f_mpi_in_place;
461: }
463: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_init_(int *ierr)
464: {
465: mpiunisetmoduleblock_();
466: *MPI_Init((int*)0, (char***)0);
467: }
469: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_finalize_(int *ierr)
470: {
471: *MPI_Finalize();
472: }
474: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
475: {
476: *size = 1;
477: *0;
478: }
480: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
481: {
482: *rank = 0;
483: *MPI_SUCCESS;
484: }
486: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr)
487: {
488: *newcomm = *comm;
489: *MPI_SUCCESS;
490: }
492: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
493: {
494: abort();
495: *MPI_SUCCESS;
496: }
498: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_reduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *root,int *comm,int *ierr)
499: {
500: *MPI_Reduce(sendbuf,recvbuf,*count,*datatype,*op,*root,*comm);
501: }
503: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
504: {
505: *MPI_Allreduce(sendbuf,recvbuf,*count,*datatype,*op,*comm);
506: }
508: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_barrier_(MPI_Comm *comm,int *ierr)
509: {
510: *MPI_SUCCESS;
511: }
513: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr)
514: {
515: *MPI_SUCCESS;
516: }
518: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype, int *root,int *comm,int *ierr)
519: {
520: *MPI_Gather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*root,*comm);
521: }
523: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype,int *comm,int *ierr)
524: {
525: *MPI_Allgather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*comm);
526: }
528: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_scan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
529: {
530: *MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPI_sizeof(*datatype));
531: }
533: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_send_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
534: {
535: *MPIUni_Abort(MPI_COMM_WORLD,0);
536: }
538: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_recv_(void *buf,int *count,int *datatype,int *source,int *tag,int *comm,int status,int *ierr)
539: {
540: *MPIUni_Abort(MPI_COMM_WORLD,0);
541: }
543: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_reduce_scatter_(void *sendbuf,void *recvbuf,int *recvcounts,int *datatype,int *op,int *comm,int *ierr)
544: {
545: *MPIUni_Abort(MPI_COMM_WORLD,0);
546: }
548: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_irecv_(void *buf,int *count, int *datatype, int *source, int *tag, int *comm, int *request, int *ierr)
549: {
550: *MPIUni_Abort(MPI_COMM_WORLD,0);
551: }
553: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_isend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *request, int *ierr)
554: {
555: *MPIUni_Abort(MPI_COMM_WORLD,0);
556: }
558: PETSC_EXTERN void PETSC_STDCALL petsc_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)
559: {
560: *MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPI_sizeof(*sendtype));
561: }
563: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_test_(int *request,int *flag,int *status,int *ierr)
564: {
565: *MPIUni_Abort(MPI_COMM_WORLD,0);
566: }
568: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_waitall_(int *count,int *array_of_requests,int *array_of_statuses,int *ierr)
569: {
570: *MPI_SUCCESS;
571: }
573: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_waitany_(int *count,int *array_of_requests,int * index, int *status,int *ierr)
574: {
575: *MPI_SUCCESS;
576: }
578: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allgatherv_(void *sendbuf,int *sendcount,int *sendtype,void *recvbuf,int *recvcounts,int *displs,int *recvtype,int *comm,int *ierr)
579: {
580: *MPI_Allgatherv(sendbuf,*sendcount,*sendtype,recvbuf,recvcounts,displs,*recvtype,*comm);
581: }
583: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_alltoallv_(void *sendbuf,int *sendcounts,int *sdispls,int *sendtype,void *recvbuf,int *recvcounts,int *rdispls,int *recvtype,int *comm,int *ierr)
584: {
585: *MPI_Alltoallv(sendbuf,sendcounts,sdispls,*sendtype,recvbuf,recvcounts,rdispls,*recvtype,*comm);
586: }
588: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_create_(int *comm,int *group,int *newcomm,int *ierr)
589: {
590: *newcomm = *comm;
591: *MPI_SUCCESS;
592: }
594: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_address_(void *location,MPI_Aint *address,int *ierr)
595: {
596: *address = (MPI_Aint) ((char *)location);
597: *MPI_SUCCESS;
598: }
600: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_pack_(void *inbuf,int *incount,int *datatype,void *outbuf,int *outsize,int *position,int *comm,int *ierr)
601: {
602: *MPIUni_Abort(MPI_COMM_WORLD,0);
603: }
605: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_unpack_(void *inbuf,int *insize,int *position,void *outbuf,int *outcount,int *datatype,int *comm,int *ierr)
606: {
607: *MPIUni_Abort(MPI_COMM_WORLD,0);
608: }
610: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_pack_size_(int *incount,int *datatype,int *comm,int *size,int *ierr)
611: {
612: *MPIUni_Abort(MPI_COMM_WORLD,0);
613: }
615: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_type_struct_(int *count,int *array_of_blocklengths,int * array_of_displaments,int *array_of_types,int *newtype,int *ierr)
616: {
617: *MPIUni_Abort(MPI_COMM_WORLD,0);
618: }
620: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_type_commit_(int *datatype,int *ierr)
621: {
622: *MPI_SUCCESS;
623: }
625: double PETSC_STDCALL petsc_mpi_wtime_(void)
626: {
627: return 0.0;
628: }
630: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_cancel_(int *request,int *ierr)
631: {
632: *MPI_SUCCESS;
633: }
635: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_dup_(int *comm,int *out,int *ierr)
636: {
637: *out = *comm;
638: *MPI_SUCCESS;
639: }
641: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_free_(int *comm,int *ierr)
642: {
643: *MPI_SUCCESS;
644: }
646: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_get_count_(int *status,int *datatype,int *count,int *ierr)
647: {
648: *MPIUni_Abort(MPI_COMM_WORLD,0);
649: }
651: /* duplicate from fortranimpl.h */
652: #ifndef PETSC_FORTRAN_CHARLEN_T
653: # define PETSC_FORTRAN_CHARLEN_T int
654: #endif
655: #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
656: #define PETSC_MIXED_LEN(len) ,PETSC_FORTRAN_CHARLEN_T len
657: #define PETSC_END_LEN(len)
658: #else
659: #define PETSC_MIXED_LEN(len)
660: #define PETSC_END_LEN(len) ,PETSC_FORTRAN_CHARLEN_T len
661: #endif
663: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_get_processor_name_(char *name PETSC_MIXED_LEN(len),int *result_len,int *ierr PETSC_END_LEN(len))
664: {
665: MPIUNI_Memcpy(name,"localhost",9*sizeof(char));
666: *result_len = 9;
667: *MPI_SUCCESS;
668: }
670: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_initialized_(int *flag,int *ierr)
671: {
672: *flag = MPI_was_initialized;
673: *MPI_SUCCESS;
674: }
676: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_iprobe_(int *source,int *tag,int *comm,int *glag,int *status,int *ierr)
677: {
678: *MPI_SUCCESS;
679: }
681: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_probe_(int *source,int *tag,int *comm,int *flag,int *status,int *ierr)
682: {
683: *MPI_SUCCESS;
684: }
686: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_request_free_(int *request,int *ierr)
687: {
688: *MPI_SUCCESS;
689: }
691: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_ssend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
692: {
693: *MPIUni_Abort(MPI_COMM_WORLD,0);
694: }
696: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_wait_(int *request,int *status,int *ierr)
697: {
698: *MPI_SUCCESS;
699: }
701: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_group_(int *comm,int *group,int *ierr)
702: {
703: *MPI_SUCCESS;
704: }
706: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_exscan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
707: {
708: *MPI_SUCCESS;
709: }
711: #endif /* PETSC_HAVE_FORTRAN */
713: #if defined(__cplusplus)
714: }
715: #endif