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 "petscconf.h"
 8:  #include mpi.h

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

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

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

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

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

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

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

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

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

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

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

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

 97: int Petsc_MPI_Attr_get(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
 98: {
 99:   if (!keyval) Keyval_setup();
100:   *flag                  = attr[keyval].active;
101:   *(int **)attribute_val = (int *)attr[keyval].attribute_val;
102:   return MPI_SUCCESS;
103: }

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

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

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

127: /* --------------------------------------------------------------------------*/

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

135: static int MPI_was_initialized = 0;

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

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

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

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

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

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

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

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

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

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

191: void MPIUNI_STDCALL  mpi_finalize__(int *ierr)
192: {
193:   *MPI_SUCCESS;
194: }

196: void MPIUNI_STDCALL  MPI_FINALIZE(int *ierr)
197: {
198:   *MPI_SUCCESS;
199: }

201: /******mpi_comm_size*******/
202: void MPIUNI_STDCALL mpi_comm_size(MPI_Comm *comm,int *size,int *ierr)
203: {
204:   *size = 1;
205:   *0;
206: }

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

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

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

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

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

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

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

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

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

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

270: void MPIUNI_STDCALL MPI_ABORT(MPI_Comm *comm,int *errorcode,int *ierr)
271: {
272:   abort();
273:   *MPI_SUCCESS;
274: }
275: /*******mpi_allreduce******/
276: void MPIUNI_STDCALL mpi_allreduce(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
277: {
278:   MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
279:   *MPI_SUCCESS;
280: }
281: void MPIUNI_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
282: {
283:   MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
284:   *MPI_SUCCESS;
285: }
286: void MPIUNI_STDCALL mpi_allreduce__(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
287: {
288:   MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
289:   *MPI_SUCCESS;
290: }
291: void MPIUNI_STDCALL MPI_ALLREDUCE(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
292: {
293:   MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
294:   *MPI_SUCCESS;
295: }


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