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