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 include/mpiuni/mpi.h
6: #include petsc.h
8: #if defined(PETSC_HAVE_STDLIB_H)
9: #include <stdlib.h>
10: #endif
12: #define MPI_SUCCESS 0
13: #define MPI_FAILURE 1
14: void *MPIUNI_TMP = 0;
15: int MPIUNI_DATASIZE[5] = { sizeof(int),sizeof(float),sizeof(double),2*sizeof(double),sizeof(char)};
16: /*
17: With MPI Uni there is only one communicator, which is called 1.
18: */
19: #define MAX_ATTR 128
21: typedef struct {
22: void *extra_state;
23: void *attribute_val;
24: int active;
25: MPI_Delete_function *del;
26: } MPI_Attr;
28: static MPI_Attr attr[MAX_ATTR];
29: static int num_attr = 1,mpi_tag_ub = 100000000;
31: #if defined(__cplusplus)
33: #endif
35: /*
36: To avoid problems with prototypes to the system memcpy() it is duplicated here
37: */
38: int MPIUNI_Memcpy(void *a,const void* b,int n) {
39: int i;
40: char *aa= (char*)a;
41: char *bb= (char*)b;
43: for (i=0; i<n; i++) aa[i] = bb[i];
44: return 0;
45: }
47: /*
48: Used to set the built-in MPI_TAG_UB attribute
49: */
50: static int Keyval_setup(void)
51: {
52: attr[0].active = 1;
53: attr[0].attribute_val = &mpi_tag_ub;
54: return 0;
55: }
57: /*
58: These functions are mapped to the Petsc_ name by ./mpi.h
59: */
60: int Petsc_MPI_Keyval_create(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
61: {
62: if (num_attr >= MAX_ATTR) MPI_Abort(MPI_COMM_WORLD,1);
64: attr[num_attr].extra_state = extra_state;
65: attr[num_attr].del = delete_fn;
66: *keyval = num_attr++;
67: return 0;
68: }
70: int Petsc_MPI_Keyval_free(int *keyval)
71: {
72: attr[*keyval].active = 0;
73: return MPI_SUCCESS;
74: }
76: int Petsc_MPI_Attr_put(MPI_Comm comm,int keyval,void *attribute_val)
77: {
78: attr[keyval].active = 1;
79: attr[keyval].attribute_val = attribute_val;
80: return MPI_SUCCESS;
81: }
82:
83: int Petsc_MPI_Attr_delete(MPI_Comm comm,int keyval)
84: {
85: if (attr[keyval].active && attr[keyval].del) {
86: (*(attr[keyval].del))(comm,keyval,attr[keyval].attribute_val,attr[keyval].extra_state);
87: }
88: attr[keyval].active = 0;
89: attr[keyval].attribute_val = 0;
90: return MPI_SUCCESS;
91: }
93: int Petsc_MPI_Attr_get(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
94: {
95: if (!keyval) Keyval_setup();
96: *flag = attr[keyval].active;
97: *(void **)attribute_val = attr[keyval].attribute_val;
98: return MPI_SUCCESS;
99: }
101: static int dups = 0;
102: int Petsc_MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
103: {
104: *out = comm;
105: dups++;
106: return 0;
107: }
109: int Petsc_MPI_Comm_free(MPI_Comm *comm)
110: {
111: int i;
113: if (--dups) return MPI_SUCCESS;
114: for (i=0; i<num_attr; i++) {
115: if (attr[i].active && attr[i].del) {
116: (*attr[i].del)(*comm,i,attr[i].attribute_val,attr[i].extra_state);
117: }
118: attr[i].active = 0;
119: }
120: return MPI_SUCCESS;
121: }
123: /* --------------------------------------------------------------------------*/
125: int Petsc_MPI_Abort(MPI_Comm comm,int errorcode)
126: {
127: abort();
128: return MPI_SUCCESS;
129: }
131: static int MPI_was_initialized = 0;
133: int Petsc_MPI_Initialized(int *flag)
134: {
135: *flag = MPI_was_initialized;
136: return 0;
137: }
139: int Petsc_MPI_Finalize(void)
140: {
141: MPI_was_initialized = 0;
142: return 0;
143: }
145: /* ------------------- Fortran versions of several routines ------------------ */
147: #if defined(PETSC_HAVE_FORTRAN_CAPS)
148: #define mpi_init_ MPI_INIT
149: #define mpi_finalize_ MPI_FINALIZE
150: #define mpi_comm_size_ MPI_COMM_SIZE
151: #define mpi_comm_rank_ MPI_COMM_RANK
152: #define mpi_abort_ MPI_ABORT
153: #define mpi_allreduce_ MPI_ALLREDUCE
154: #define mpi_barrier_ MPI_BARRIER
155: #define mpi_bcast_ MPI_BCAST
156: #define mpi_gather_ MPI_GATHER
157: #define mpi_allgather_ MPI_ALLGATHER
158: #define mpi_comm_split_ MPI_COMM_SPLIT
159: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
160: #define mpi_init_ mpi_init
161: #define mpi_finalize_ mpi_finalize
162: #define mpi_comm_size_ mpi_comm_size
163: #define mpi_comm_rank_ mpi_comm_rank
164: #define mpi_abort_ mpi_abort
165: #define mpi_allreduce_ mpi_allreduce
166: #define mpi_barrier_ mpi_barrier
167: #define mpi_bcast_ mpi_bcast
168: #define mpi_gather_ mpi_gather
169: #define mpi_allgather_ mpi_allgather
170: #define mpi_comm_split_ mpi_comm_split
171: #endif
173: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
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_allreduce_ mpi_allreduce__
180: #define mpi_barrier_ mpi_barrier__
181: #define mpi_bcast_ mpi_bcast__
182: #define mpi_gather_ mpi_gather__
183: #define mpi_allgather_ mpi_allgather__
184: #define mpi_comm_split_ mpi_comm_split__
185: #endif
187: void PETSC_STDCALL mpi_init_(int *ierr)
188: {
189: MPI_was_initialized = 1;
190: *MPI_SUCCESS;
191: }
193: void PETSC_STDCALL mpi_finalize_(int *ierr)
194: {
195: *MPI_SUCCESS;
196: }
198: void PETSC_STDCALL mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
199: {
200: *size = 1;
201: *0;
202: }
204: void PETSC_STDCALL mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
205: {
206: *rank=0;
207: *ierr=MPI_SUCCESS;
208: }
210: void PETSC_STDCALL mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr)
211: {
212: *newcomm = *comm;
213: *ierr=MPI_SUCCESS;
214: }
216: void PETSC_STDCALL mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
217: {
218: abort();
219: *MPI_SUCCESS;
220: }
222: void PETSC_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
223: {
224: MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
225: *MPI_SUCCESS;
226: }
228: void PETSC_STDCALL mpi_barrier_(MPI_Comm *comm,int *ierr)
229: {
230: *MPI_SUCCESS;
231: }
233: void PETSC_STDCALL mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr)
234: {
235: *MPI_SUCCESS;
236: }
239: void PETSC_STDCALL mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype, int *root,int *comm,int *ierr)
240: {
241: MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]);
242: *MPI_SUCCESS;
243: }
246: void PETSC_STDCALL mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype,int *comm,int *ierr)
247: {
248: MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]);
249: *MPI_SUCCESS;
250: }
252: #if defined(__cplusplus)
253: }
254: #endif