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 (MPIUNI_USE_STDCALL) 8 #define MPIUNI_STDCALL __stdcall 9 #else 10 #define MPIUNI_STDCALL 11 #endif 12 13 #if defined(PETSC_HAVE_STDLIB_H) 14 #include <stdlib.h> 15 #endif 16 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 25 26 typedef struct { 27 void *extra_state; 28 void *attribute_val; 29 int active; 30 MPI_Delete_function *del; 31 } MPI_Attr; 32 33 static MPI_Attr attr[MAX_ATTR]; 34 static int num_attr = 1,mpi_tag_ub = 100000000; 35 36 #if defined(__cplusplus) 37 extern "C" { 38 #endif 39 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; 47 48 for (i=0; i<n; i++) aa[i] = bb[i]; 49 return 0; 50 } 51 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 } 61 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); 68 69 attr[num_attr].extra_state = extra_state; 70 attr[num_attr].del = delete_fn; 71 *keyval = num_attr++; 72 return 0; 73 } 74 75 int Petsc_MPI_Keyval_free(int *keyval) 76 { 77 attr[*keyval].active = 0; 78 return MPI_SUCCESS; 79 } 80 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 } 97 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 *(int **)attribute_val = (int*)attr[keyval].attribute_val; 103 return MPI_SUCCESS; 104 } 105 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 } 113 114 int Petsc_MPI_Comm_free(MPI_Comm *comm) 115 { 116 int i; 117 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 } 127 128 /* --------------------------------------------------------------------------*/ 129 130 int Petsc_MPI_Abort(MPI_Comm comm,int errorcode) 131 { 132 abort(); 133 return MPI_SUCCESS; 134 } 135 136 static int MPI_was_initialized = 0; 137 138 int Petsc_MPI_Initialized(int *flag) 139 { 140 *flag = MPI_was_initialized; 141 return 0; 142 } 143 144 int Petsc_MPI_Finalize(void) 145 { 146 MPI_was_initialized = 0; 147 return 0; 148 } 149 150 /* ------------------- Fortran versions of several routines ------------------ */ 151 152 153 /******mpi_init*******/ 154 void MPIUNI_STDCALL mpi_init(int *ierr) 155 { 156 MPI_was_initialized = 1; 157 *ierr = MPI_SUCCESS; 158 } 159 160 void MPIUNI_STDCALL mpi_init_(int *ierr) 161 { 162 MPI_was_initialized = 1; 163 *ierr = MPI_SUCCESS; 164 } 165 166 void MPIUNI_STDCALL mpi_init__(int *ierr) 167 { 168 MPI_was_initialized = 1; 169 *ierr = MPI_SUCCESS; 170 } 171 172 void MPIUNI_STDCALL MPI_INIT(int *ierr) 173 { 174 MPI_was_initialized = 1; 175 *ierr = MPI_SUCCESS; 176 } 177 178 /******mpi_finalize*******/ 179 void MPIUNI_STDCALL mpi_finalize(int *ierr) 180 { 181 *ierr = MPI_SUCCESS; 182 } 183 184 void MPIUNI_STDCALL mpi_finalize_(int *ierr) 185 { 186 *ierr = MPI_SUCCESS; 187 } 188 189 void MPIUNI_STDCALL mpi_finalize__(int *ierr) 190 { 191 *ierr = MPI_SUCCESS; 192 } 193 194 void MPIUNI_STDCALL MPI_FINALIZE(int *ierr) 195 { 196 *ierr = MPI_SUCCESS; 197 } 198 199 /******mpi_comm_size*******/ 200 void MPIUNI_STDCALL mpi_comm_size(MPI_Comm *comm,int *size,int *ierr) 201 { 202 *size = 1; 203 *ierr = 0; 204 } 205 206 void MPIUNI_STDCALL mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr) 207 { 208 *size = 1; 209 *ierr = 0; 210 } 211 212 void MPIUNI_STDCALL mpi_comm_size__(MPI_Comm *comm,int *size,int *ierr) 213 { 214 *size = 1; 215 *ierr = 0; 216 } 217 218 void MPIUNI_STDCALL MPI_COMM_SIZE(MPI_Comm *comm,int *size,int *ierr) 219 { 220 *size = 1; 221 *ierr = 0; 222 } 223 224 /******mpi_comm_rank*******/ 225 void MPIUNI_STDCALL mpi_comm_rank(MPI_Comm *comm,int *rank,int *ierr) 226 { 227 *rank=0; 228 *ierr=MPI_SUCCESS; 229 } 230 231 void MPIUNI_STDCALL mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr) 232 { 233 *rank=0; 234 *ierr=MPI_SUCCESS; 235 } 236 237 void MPIUNI_STDCALL mpi_comm_rank__(MPI_Comm *comm,int *rank,int *ierr) 238 { 239 *rank=0; 240 *ierr=MPI_SUCCESS; 241 } 242 243 void MPIUNI_STDCALL MPI_COMM_RANK(MPI_Comm *comm,int *rank,int *ierr) 244 { 245 *rank=0; 246 *ierr=MPI_SUCCESS; 247 } 248 249 /*******mpi_abort******/ 250 void MPIUNI_STDCALL mpi_abort(MPI_Comm *comm,int *errorcode,int *ierr) 251 { 252 abort(); 253 *ierr = MPI_SUCCESS; 254 } 255 256 void MPIUNI_STDCALL mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr) 257 { 258 abort(); 259 *ierr = MPI_SUCCESS; 260 } 261 262 void MPIUNI_STDCALL mpi_abort__(MPI_Comm *comm,int *errorcode,int *ierr) 263 { 264 abort(); 265 *ierr = MPI_SUCCESS; 266 } 267 268 void MPIUNI_STDCALL MPI_ABORT(MPI_Comm *comm,int *errorcode,int *ierr) 269 { 270 abort(); 271 *ierr = MPI_SUCCESS; 272 } 273 /*******mpi_allreduce******/ 274 void MPIUNI_STDCALL mpi_allreduce(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 275 { 276 MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]); 277 *ierr = MPI_SUCCESS; 278 } 279 void MPIUNI_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 280 { 281 MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]); 282 *ierr = MPI_SUCCESS; 283 } 284 void MPIUNI_STDCALL mpi_allreduce__(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 285 { 286 MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]); 287 *ierr = MPI_SUCCESS; 288 } 289 void MPIUNI_STDCALL MPI_ALLREDUCE(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 290 { 291 MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]); 292 *ierr = MPI_SUCCESS; 293 } 294 295 void MPIUNI_STDCALL mpi_barrier(MPI_Comm *comm,int *ierr) 296 { 297 *ierr = MPI_SUCCESS; 298 } 299 void MPIUNI_STDCALL mpi_barrier_(MPI_Comm *comm,int *ierr) 300 { 301 *ierr = MPI_SUCCESS; 302 } 303 void MPIUNI_STDCALL mpi_barrier__(MPI_Comm *comm,int *ierr) 304 { 305 *ierr = MPI_SUCCESS; 306 } 307 void MPIUNI_STDCALL MPI_BARRIER(MPI_Comm *comm,int *ierr) 308 { 309 *ierr = MPI_SUCCESS; 310 } 311 312 #if defined(__cplusplus) 313 } 314 #endif 315 316 317