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

  7: #if defined (MPIUNI_USE_STDCALL)
  8: #define MPIUNI_STDCALL __stdcall
  9: #else
 10: #define MPIUNI_STDCALL
 11: #endif

 13: #if defined(PETSC_HAVE_STDLIB_H)
 14: #include <stdlib.h>
 15: #endif

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

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

 33: static MPI_Attr attr[MAX_ATTR];
 34: static int      num_attr = 1,mpi_tag_ub = 100000000;

 36: #if defined(__cplusplus)
 38: #endif

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

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

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

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

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

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

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

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

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

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

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

128: /* --------------------------------------------------------------------------*/

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

136: static int MPI_was_initialized = 0;

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

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

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

152: #if defined(PETSC_HAVE_FORTRAN_CAPS)
153: #define mpi_init_             MPI_INIT
154: #define mpi_finalize_         MPI_FINALIZE
155: #define mpi_comm_size_        MPI_COMM_SIZE
156: #define mpi_comm_rank_        MPI_COMM_RANK
157: #define mpi_abort_            MPI_ABORT
158: #define mpi_allreduce_        MPI_ALLREDUCE
159: #define mpi_barrier_          MPI_BARRIER
160: #define mpi_bcast_            MPI_BCAST
161: #define mpi_gather_           MPI_GATHER
162: #define mpi_allgather_        MPI_ALLGATHER
163: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
164: #define mpi_init_             mpi_init
165: #define mpi_finalize_         mpi_finalize
166: #define mpi_comm_size_        mpi_comm_size
167: #define mpi_comm_rank_        mpi_comm_rank
168: #define mpi_abort_            mpi_abort
169: #define mpi_allreduce_        mpi_allreduce
170: #define mpi_barrier_          mpi_barrier
171: #define mpi_bcast_            mpi_bcast
172: #define mpi_gather_           mpi_gather
173: #define mpi_allgather_        mpi_allgather
174: #endif

176: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
177: #define mpi_init_             mpi_init__
178: #define mpi_finalize_         mpi_finalize__
179: #define mpi_comm_size_        mpi_comm_size__
180: #define mpi_comm_rank_        mpi_comm_rank__
181: #define mpi_abort_            mpi_abort__
182: #define mpi_allreduce_        mpi_allreduce__
183: #define mpi_barrier_          mpi_barrier__
184: #define mpi_bcast_            mpi_bcast__
185: #define mpi_gather_           mpi_gather__
186: #define mpi_allgather_        mpi_allgather__
187: #endif

189: void MPIUNI_STDCALL  mpi_init_(int *ierr)
190: {
191:   MPI_was_initialized = 1;
192:   *MPI_SUCCESS;
193: }

195: void MPIUNI_STDCALL  mpi_finalize_(int *ierr)
196: {
197:   *MPI_SUCCESS;
198: }

200: void MPIUNI_STDCALL mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
201: {
202:   *size = 1;
203:   *0;
204: }

206: void MPIUNI_STDCALL mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
207: {
208:   *rank=0;
209:   *ierr=MPI_SUCCESS;
210: }

212: void MPIUNI_STDCALL mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
213: {
214:   abort();
215:   *MPI_SUCCESS;
216: }

218: void MPIUNI_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
219: {
220:   MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]);
221:   *MPI_SUCCESS;
222: }

224: void MPIUNI_STDCALL mpi_barrier_(MPI_Comm *comm,int *ierr)
225: {
226:   *MPI_SUCCESS;
227: }

229: void MPIUNI_STDCALL mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr)
230: {
231:   *MPI_SUCCESS;
232: }


235: void MPIUNI_STDCALL mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype, int *root,int *comm,int *ierr)
236: {
237:   MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]);
238:   *MPI_SUCCESS;
239: }


242: void MPIUNI_STDCALL mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype,int *comm,int *ierr)
243: {
244:   MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]);
245:   *MPI_SUCCESS;
246: }

248: #if defined(__cplusplus)
249: }
250: #endif