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 include/mpiuni/mpi.h

  9: #if defined (MPIUNI_USE_STDCALL)
 10: #define MPIUNI_STDCALL __stdcall
 11: #else
 12: #define MPIUNI_STDCALL
 13: #endif

 15: #if defined(PETSC_HAVE_STDLIB_H)
 16: #include <stdlib.h>
 17: #endif

 19: #define MPI_SUCCESS 0
 20: #define MPI_FAILURE 1
 21: void    *MPIUNI_TMP        = 0;
 22: int     MPIUNI_DATASIZE[5] = { sizeof(int),sizeof(float),sizeof(double),2*sizeof(double),sizeof(char)};
 23: /*
 24:        With MPI Uni there is only one communicator, which is called 1.
 25: */
 26: #define MAX_ATTR 128

 28: typedef struct {
 29:   void                *extra_state;
 30:   void                *attribute_val;
 31:   int                 active;
 32:   MPI_Delete_function *del;
 33: } MPI_Attr;

 35: static MPI_Attr attr[MAX_ATTR];
 36: static int      num_attr = 1,mpi_tag_ub = 100000000;

 38: /* 
 39:    To avoid problems with prototypes to the system memcpy() it is duplicated here
 40: */
 41: int MPIUNI_Memcpy(void *a,void* b,int n) {
 42:   int  i;
 43:   char *aa= (char*)a;
 44:   char *bb= (char*)b;

 46:   for (i=0; i<n; i++) aa[i] = bb[i];
 47:   return 0;
 48: }

 50: /*
 51:    Used to set the built-in MPI_TAG_UB attribute
 52: */
 53: static int Keyval_setup(void)
 54: {
 55:   attr[0].active        = 1;
 56:   attr[0].attribute_val = &mpi_tag_ub;
 57:   return 0;
 58: }

 60: /*
 61:          These functions are mapped to the Petsc_ name by ./mpi.h
 62: */
 63: int Petsc_MPI_Keyval_create(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
 64: {
 65:   if (num_attr >= MAX_ATTR) MPI_Abort(MPI_COMM_WORLD,1);

 67:   attr[num_attr].extra_state = extra_state;
 68:   attr[num_attr].del         = delete_fn;
 69:   *keyval                    = num_attr++;
 70:   return 0;
 71: }

 73: int Petsc_MPI_Keyval_free(int *keyval)
 74: {
 75:   attr[*keyval].active = 0;
 76:   return MPI_SUCCESS;
 77: }

 79: int Petsc_MPI_Attr_put(MPI_Comm comm,int keyval,void *attribute_val)
 80: {
 81:   attr[keyval].active        = 1;
 82:   attr[keyval].attribute_val = attribute_val;
 83:   return MPI_SUCCESS;
 84: }
 85: 
 86: int Petsc_MPI_Attr_delete(MPI_Comm comm,int keyval)
 87: {
 88:   if (attr[keyval].active && attr[keyval].del) {
 89:     (*(attr[keyval].del))(comm,keyval,attr[keyval].attribute_val,attr[keyval].extra_state);
 90:   }
 91:   attr[keyval].active        = 0;
 92:   attr[keyval].attribute_val = 0;
 93:   return MPI_SUCCESS;
 94: }

 96: int Petsc_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:   *(int **)attribute_val = (int *)attr[keyval].attribute_val;
101:   return MPI_SUCCESS;
102: }

104: static int dups = 0;
105: int Petsc_MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
106: {
107:   *out = comm;
108:   dups++;
109:   return 0;
110: }

112: int Petsc_MPI_Comm_free(MPI_Comm *comm)
113: {
114:   int i;

116:   if (--dups) return MPI_SUCCESS;
117:   for (i=0; i<num_attr; i++) {
118:     if (attr[i].active && attr[i].del) {
119:       (*attr[i].del)(*comm,i,attr[i].attribute_val,attr[i].extra_state);
120:     }
121:     attr[i].active = 0;
122:   }
123:   return MPI_SUCCESS;
124: }

126: /* --------------------------------------------------------------------------*/

128: int Petsc_MPI_Abort(MPI_Comm comm,int errorcode)
129: {
130:   abort();
131:   return MPI_SUCCESS;
132: }

134: static int MPI_was_initialized = 0;

136: int Petsc_MPI_Initialized(int *flag)
137: {
138:   *flag = MPI_was_initialized;
139:   return 0;
140: }

142: int Petsc_MPI_Finalize(void)
143: {
144:   MPI_was_initialized = 0;
145:   return 0;
146: }

148: /* -------------------     Fortran versions of several routines ------------------ */

150: #if defined(__cplusplus)
151: extern "C" {
152: #endif

154: /******mpi_init*******/
155: void MPIUNI_STDCALL  mpi_init(int *ierr)
156: {
157:   MPI_was_initialized = 1;
158:   *MPI_SUCCESS;
159: }

161: void MPIUNI_STDCALL  mpi_init_(int *ierr)
162: {
163:   MPI_was_initialized = 1;
164:   *MPI_SUCCESS;
165: }

167: void MPIUNI_STDCALL  mpi_init__(int *ierr)
168: {
169:   MPI_was_initialized = 1;
170:   *MPI_SUCCESS;
171: }

173: void MPIUNI_STDCALL  MPI_INIT(int *ierr)
174: {
175:   MPI_was_initialized = 1;
176:   *MPI_SUCCESS;
177: }

179: /******mpi_finalize*******/
180: void MPIUNI_STDCALL  mpi_finalize(int *ierr)
181: {
182:   *MPI_SUCCESS;
183: }

185: void MPIUNI_STDCALL  mpi_finalize_(int *ierr)
186: {
187:   *MPI_SUCCESS;
188: }

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: /******mpi_comm_size*******/
201: void MPIUNI_STDCALL mpi_comm_size(MPI_Comm *comm,int *size,int *ierr)
202: {
203:   *size = 1;
204:   *0;
205: }

207: void MPIUNI_STDCALL mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
208: {
209:   *size = 1;
210:   *0;
211: }

213: void MPIUNI_STDCALL mpi_comm_size__(MPI_Comm *comm,int *size,int *ierr)
214: {
215:   *size = 1;
216:   *0;
217: }

219: void MPIUNI_STDCALL MPI_COMM_SIZE(MPI_Comm *comm,int *size,int *ierr)
220: {
221:   *size = 1;
222:   *0;
223: }

225: /******mpi_comm_rank*******/
226: void MPIUNI_STDCALL mpi_comm_rank(MPI_Comm *comm,int *rank,int *ierr)
227: {
228:   *rank=0;
229:   *ierr=MPI_SUCCESS;
230: }

232: void MPIUNI_STDCALL mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
233: {
234:   *rank=0;
235:   *ierr=MPI_SUCCESS;
236: }

238: void MPIUNI_STDCALL mpi_comm_rank__(MPI_Comm *comm,int *rank,int *ierr)
239: {
240:   *rank=0;
241:   *ierr=MPI_SUCCESS;
242: }

244: void MPIUNI_STDCALL MPI_COMM_RANK(MPI_Comm *comm,int *rank,int *ierr)
245: {
246:   *rank=0;
247:   *ierr=MPI_SUCCESS;
248: }

250: /*******mpi_abort******/
251: void MPIUNI_STDCALL mpi_abort(MPI_Comm *comm,int *errorcode,int *ierr)
252: {
253:   abort();
254:   *MPI_SUCCESS;
255: }

257: void MPIUNI_STDCALL mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
258: {
259:   abort();
260:   *MPI_SUCCESS;
261: }

263: void MPIUNI_STDCALL mpi_abort__(MPI_Comm *comm,int *errorcode,int *ierr)
264: {
265:   abort();
266:   *MPI_SUCCESS;
267: }

269: void MPIUNI_STDCALL MPI_ABORT(MPI_Comm *comm,int *errorcode,int *ierr)
270: {
271:   abort();
272:   *MPI_SUCCESS;
273: }
274: /*******mpi_allreduce******/
275: void MPIUNI_STDCALL mpi_allreduce(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
276: {
277:   MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
278:   *MPI_SUCCESS;
279: }
280: void MPIUNI_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
281: {
282:   MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
283:   *MPI_SUCCESS;
284: }
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: }


297: #if defined(__cplusplus)
298: }
299: #endif