Actual source code: mpi.c
1: /*$Id: mpi.c,v 1.59 2000/02/12 02:59:59 bsmith Exp $*/
3: /*
4: This provides a few of the MPI-uni functions that cannot be implemented
5: with C macros
6: */
7: #include "mpi.h"
9: #if defined (MPIUNI_USE_STDCALL)
10: #define MPIUNI_STDCALL __stdcall
11: #else
12: #define MPIUNI_STDCALL
13: #endif
15: /*
16: The system call exit() is not properly prototyped on all systems
17: hence we fake it by creating our own prototype
18: */
20: /* This file does not include petsc.h hence cannot use EXTERN_C_XXXX*/
21: #if defined(__cplusplus)
22: extern "C" {
23: void exit(int);
24: }
25: #else
26: void exit(int);
27: #endif
29: #define MPI_SUCCESS 0
30: #define MPI_FAILURE 1
31: void *MPIUNI_TMP = 0;
32: int MPIUNI_DATASIZE[5] = { sizeof(int),sizeof(float),sizeof(double),2*sizeof(double),sizeof(char)};
33: /*
34: With MPI Uni there is only one communicator, which is called 1.
35: */
36: #define MAX_ATTR 128
38: typedef struct {
39: void *extra_state;
40: void *attribute_val;
41: int active;
42: MPI_Delete_function *del;
43: } MPI_Attr;
45: static MPI_Attr attr[MAX_ATTR];
46: static int num_attr = 1,mpi_tag_ub = 100000000;
48: /*
49: To avoid problems with prototypes to the system memcpy() it is duplicated here
50: */
51: int MPIUNI_Memcpy(void *a,void* b,int n) {
52: int i;
53: char *aa= (char*)a;
54: char *bb= (char*)b;
56: for (i=0; i<n; i++) aa[i] = bb[i];
57: return 0;
58: }
60: /*
61: Used to set the built-in MPI_TAG_UB attribute
62: */
63: static int Keyval_setup(void)
64: {
65: attr[0].active = 1;
66: attr[0].attribute_val = &mpi_tag_ub;
67: return 0;
68: }
70: /*
71: These functions are mapped to the Petsc_ name by ./mpi.h
72: */
73: int Petsc_MPI_Keyval_create(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
74: {
75: if (num_attr >= MAX_ATTR) MPI_Abort(MPI_COMM_WORLD,1);
77: attr[num_attr].extra_state = extra_state;
78: attr[num_attr].del = delete_fn;
79: *keyval = num_attr++;
80: return 0;
81: }
83: int Petsc_MPI_Keyval_free(int *keyval)
84: {
85: attr[*keyval].active = 0;
86: return MPI_SUCCESS;
87: }
89: int Petsc_MPI_Attr_put(MPI_Comm comm,int keyval,void *attribute_val)
90: {
91: attr[keyval].active = 1;
92: attr[keyval].attribute_val = attribute_val;
93: return MPI_SUCCESS;
94: }
95:
96: int Petsc_MPI_Attr_delete(MPI_Comm comm,int keyval)
97: {
98: if (attr[keyval].active && attr[keyval].del) {
99: (*(attr[keyval].del))(comm,keyval,attr[keyval].attribute_val,attr[keyval].extra_state);
100: }
101: attr[keyval].active = 0;
102: attr[keyval].attribute_val = 0;
103: return MPI_SUCCESS;
104: }
106: int Petsc_MPI_Attr_get(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
107: {
108: if (!keyval) Keyval_setup();
109: *flag = attr[keyval].active;
110: *(int **)attribute_val = (int *)attr[keyval].attribute_val;
111: return MPI_SUCCESS;
112: }
114: static int dups = 0;
115: int Petsc_MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
116: {
117: *out = comm;
118: dups++;
119: return 0;
120: }
122: int Petsc_MPI_Comm_free(MPI_Comm *comm)
123: {
124: int i;
126: if (--dups) return MPI_SUCCESS;
127: for (i=0; i<num_attr; i++) {
128: if (attr[i].active && attr[i].del) {
129: (*attr[i].del)(*comm,i,attr[i].attribute_val,attr[i].extra_state);
130: }
131: attr[i].active = 0;
132: }
133: return MPI_SUCCESS;
134: }
136: /* --------------------------------------------------------------------------*/
138: int Petsc_MPI_Abort(MPI_Comm comm,int errorcode)
139: {
140: exit(errorcode);
141: return MPI_SUCCESS;
142: }
144: static int MPI_was_initialized = 0;
146: int Petsc_MPI_Initialized(int *flag)
147: {
148: *flag = MPI_was_initialized;
149: return 0;
150: }
152: int Petsc_MPI_Finalize(void)
153: {
154: MPI_was_initialized = 0;
155: return 0;
156: }
158: /* ------------------- Fortran versions of several routines ------------------ */
160: #if defined(__cplusplus)
161: extern "C" {
162: #endif
164: /******mpi_init*******/
165: void MPIUNI_STDCALL mpi_init(int *ierr)
166: {
167: MPI_was_initialized = 1;
168: *MPI_SUCCESS;
169: }
171: void MPIUNI_STDCALL mpi_init_(int *ierr)
172: {
173: MPI_was_initialized = 1;
174: *MPI_SUCCESS;
175: }
177: void MPIUNI_STDCALL mpi_init__(int *ierr)
178: {
179: MPI_was_initialized = 1;
180: *MPI_SUCCESS;
181: }
183: void MPIUNI_STDCALL MPI_INIT(int *ierr)
184: {
185: MPI_was_initialized = 1;
186: *MPI_SUCCESS;
187: }
189: /******mpi_finalize*******/
190: void MPIUNI_STDCALL mpi_finalize(int *ierr)
191: {
192: *MPI_SUCCESS;
193: }
195: void MPIUNI_STDCALL mpi_finalize_(int *ierr)
196: {
197: *MPI_SUCCESS;
198: }
200: void MPIUNI_STDCALL mpi_finalize__(int *ierr)
201: {
202: *MPI_SUCCESS;
203: }
205: void MPIUNI_STDCALL MPI_FINALIZE(int *ierr)
206: {
207: *MPI_SUCCESS;
208: }
210: /******mpi_comm_size*******/
211: void MPIUNI_STDCALL mpi_comm_size(MPI_Comm *comm,int *size,int *ierr)
212: {
213: *size = 1;
214: *0;
215: }
217: void MPIUNI_STDCALL mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
218: {
219: *size = 1;
220: *0;
221: }
223: void MPIUNI_STDCALL mpi_comm_size__(MPI_Comm *comm,int *size,int *ierr)
224: {
225: *size = 1;
226: *0;
227: }
229: void MPIUNI_STDCALL MPI_COMM_SIZE(MPI_Comm *comm,int *size,int *ierr)
230: {
231: *size = 1;
232: *0;
233: }
235: /******mpi_comm_rank*******/
236: void MPIUNI_STDCALL mpi_comm_rank(MPI_Comm *comm,int *rank,int *ierr)
237: {
238: *rank=0;
239: *ierr=MPI_SUCCESS;
240: }
242: void MPIUNI_STDCALL mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
243: {
244: *rank=0;
245: *ierr=MPI_SUCCESS;
246: }
248: void MPIUNI_STDCALL mpi_comm_rank__(MPI_Comm *comm,int *rank,int *ierr)
249: {
250: *rank=0;
251: *ierr=MPI_SUCCESS;
252: }
254: void MPIUNI_STDCALL MPI_COMM_RANK(MPI_Comm *comm,int *rank,int *ierr)
255: {
256: *rank=0;
257: *ierr=MPI_SUCCESS;
258: }
260: /*******mpi_abort******/
261: void MPIUNI_STDCALL mpi_abort(MPI_Comm *comm,int *errorcode,int *ierr)
262: {
263: exit(*errorcode);
264: *MPI_SUCCESS;
265: }
267: void MPIUNI_STDCALL mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
268: {
269: exit(*errorcode);
270: *MPI_SUCCESS;
271: }
273: void MPIUNI_STDCALL mpi_abort__(MPI_Comm *comm,int *errorcode,int *ierr)
274: {
275: exit(*errorcode);
276: *MPI_SUCCESS;
277: }
279: void MPIUNI_STDCALL MPI_ABORT(MPI_Comm *comm,int *errorcode,int *ierr)
280: {
281: exit(*errorcode);
282: *MPI_SUCCESS;
283: }
284: /*******mpi_allreduce******/
285: void MPIUNI_STDCALL mpi_allreduce(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
286: {
287: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
288: *MPI_SUCCESS;
289: }
290: void MPIUNI_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
291: {
292: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
293: *MPI_SUCCESS;
294: }
295: void MPIUNI_STDCALL mpi_allreduce__(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
296: {
297: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
298: *MPI_SUCCESS;
299: }
300: void MPIUNI_STDCALL MPI_ALLREDUCE(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
301: {
302: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
303: *MPI_SUCCESS;
304: }
307: #if defined(__cplusplus)
308: }
309: #endif