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