1 /* 2 This provides a few of the MPI-uni functions that cannot be implemented 3 with C macros 4 */ 5 #include "mpi.h" 6 #if !defined(__MPIUNI_H) 7 #error "Wrong mpi.h included! require mpi.h from MPIUNI" 8 #endif 9 #if !defined(PETSC_STDCALL) 10 #define PETSC_STDCALL 11 #endif 12 #include <stdio.h> 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[7] = {sizeof(int),sizeof(float),sizeof(double),2*sizeof(double),sizeof(char),2*sizeof(int),4*sizeof(double)}; 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 int MPI_Keyval_create(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state) 63 { 64 if (num_attr >= MAX_ATTR) MPI_Abort(MPI_COMM_WORLD,1); 65 66 attr[num_attr].extra_state = extra_state; 67 attr[num_attr].del = delete_fn; 68 *keyval = num_attr++; 69 return 0; 70 } 71 72 int MPI_Keyval_free(int *keyval) 73 { 74 attr[*keyval].active = 0; 75 return MPI_SUCCESS; 76 } 77 78 int MPI_Attr_put(MPI_Comm comm,int keyval,void *attribute_val) 79 { 80 attr[keyval].active = 1; 81 attr[keyval].attribute_val = attribute_val; 82 return MPI_SUCCESS; 83 } 84 85 int MPI_Attr_delete(MPI_Comm comm,int keyval) 86 { 87 if (attr[keyval].active && attr[keyval].del) { 88 (*(attr[keyval].del))(comm,keyval,attr[keyval].attribute_val,attr[keyval].extra_state); 89 } 90 attr[keyval].active = 0; 91 attr[keyval].attribute_val = 0; 92 return MPI_SUCCESS; 93 } 94 95 int MPI_Attr_get(MPI_Comm comm,int keyval,void *attribute_val,int *flag) 96 { 97 if (!keyval) Keyval_setup(); 98 *flag = attr[keyval].active; 99 *(void **)attribute_val = attr[keyval].attribute_val; 100 return MPI_SUCCESS; 101 } 102 103 int MPI_Comm_create(MPI_Comm comm,MPI_Group group,MPI_Comm *newcomm) 104 { 105 *newcomm = comm; 106 return MPI_SUCCESS; 107 } 108 109 static int dups = 0; 110 int MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out) 111 { 112 *out = comm; 113 dups++; 114 return 0; 115 } 116 117 int MPI_Comm_free(MPI_Comm *comm) 118 { 119 int i; 120 121 if (--dups) return MPI_SUCCESS; 122 for (i=0; i<num_attr; i++) { 123 if (attr[i].active && attr[i].del) { 124 (*attr[i].del)(*comm,i,attr[i].attribute_val,attr[i].extra_state); 125 } 126 attr[i].active = 0; 127 } 128 return MPI_SUCCESS; 129 } 130 131 int MPI_Abort(MPI_Comm comm,int errorcode) 132 { 133 abort(); 134 return MPI_SUCCESS; 135 } 136 137 /* --------------------------------------------------------------------------*/ 138 139 static int MPI_was_initialized = 0; 140 static int MPI_was_finalized = 0; 141 142 int MPI_Init(int *argc, char ***argv) 143 { 144 if (MPI_was_initialized) return 1; 145 if (MPI_was_finalized) return 1; 146 MPI_was_initialized = 1; 147 return 0; 148 } 149 150 int MPI_Finalize(void) 151 { 152 if (MPI_was_finalized) return 1; 153 if (!MPI_was_initialized) return 1; 154 MPI_was_finalized = 1; 155 return 0; 156 } 157 158 int MPI_Initialized(int *flag) 159 { 160 *flag = MPI_was_initialized; 161 return 0; 162 } 163 164 int MPI_Finalized(int *flag) 165 { 166 *flag = MPI_was_finalized; 167 return 0; 168 } 169 170 /* ------------------- Fortran versions of several routines ------------------ */ 171 172 #if defined(PETSC_HAVE_FORTRAN_CAPS) 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_reduce_ MPI_REDUCE 179 #define mpi_allreduce_ MPI_ALLREDUCE 180 #define mpi_barrier_ MPI_BARRIER 181 #define mpi_bcast_ MPI_BCAST 182 #define mpi_gather_ MPI_GATHER 183 #define mpi_allgather_ MPI_ALLGATHER 184 #define mpi_comm_split_ MPI_COMM_SPLIT 185 #define mpi_scan_ MPI_SCAN 186 #define mpi_send_ MPI_SEND 187 #define mpi_recv_ MPI_RECV 188 #define mpi_reduce_scatter_ MPI_REDUCE_SCATTER 189 #define mpi_irecv_ MPI_IRECV 190 #define mpi_isend_ MPI_ISEND 191 #define mpi_sendrecv_ MPI_SENDRECV 192 #define mpi_test_ MPI_TEST 193 #define mpi_waitall_ MPI_WAITALL 194 #define mpi_waitany_ MPI_WAITANY 195 #define mpi_allgatherv_ MPI_ALLGATHERV 196 #define mpi_alltoallv_ MPI_ALLTOALLV 197 #define mpi_comm_create_ MPI_COMM_CREATE 198 #define mpi_address_ MPI_ADDRESS 199 #define mpi_pack_ MPI_PACK 200 #define mpi_unpack_ MPI_UNPACK 201 #define mpi_pack_size_ MPI_PACK_SIZE 202 #define mpi_type_struct_ MPI_TYPE_STRUCT 203 #define mpi_type_commit_ MPI_TYPE_COMMIT 204 #define mpi_wtime_ MPI_WTIME 205 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 206 #define mpi_init_ mpi_init 207 #define mpi_finalize_ mpi_finalize 208 #define mpi_comm_size_ mpi_comm_size 209 #define mpi_comm_rank_ mpi_comm_rank 210 #define mpi_abort_ mpi_abort 211 #define mpi_reduce_ mpi_reduce 212 #define mpi_allreduce_ mpi_allreduce 213 #define mpi_barrier_ mpi_barrier 214 #define mpi_bcast_ mpi_bcast 215 #define mpi_gather_ mpi_gather 216 #define mpi_allgather_ mpi_allgather 217 #define mpi_comm_split_ mpi_comm_split 218 #define mpi_scan_ mpi_scan 219 #define mpi_send_ mpi_send 220 #define mpi_recv_ mpi_recv 221 #define mpi_reduce_scatter_ mpi_reduce_scatter 222 #define mpi_irecv_ mpi_irecv 223 #define mpi_isend_ mpi_isend 224 #define mpi_sendrecv_ mpi_sendrecv 225 #define mpi_test_ mpi_test 226 #define mpi_waitall_ mpi_waitall 227 #define mpi_waitany_ mpi_waitany 228 #define mpi_allgatherv_ mpi_allgatherv 229 #define mpi_alltoallv_ mpi_alltoallv 230 #define mpi_comm_create_ mpi_comm_create 231 #define mpi_address_ mpi_address 232 #define mpi_pack_ mpi_pack 233 #define mpi_unpack_ mpi_unpack 234 #define mpi_pack_size_ mpi_pack_size 235 #define mpi_type_struct_ mpi_type_struct 236 #define mpi_type_commit_ mpi_type_commit 237 #define mpi_wtime_ mpi_wtime 238 #endif 239 240 #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE) 241 #define mpi_init_ mpi_init__ 242 #define mpi_finalize_ mpi_finalize__ 243 #define mpi_comm_size_ mpi_comm_size__ 244 #define mpi_comm_rank_ mpi_comm_rank__ 245 #define mpi_abort_ mpi_abort__ 246 #define mpi_reduce_ mpi_reduce__ 247 #define mpi_allreduce_ mpi_allreduce__ 248 #define mpi_barrier_ mpi_barrier__ 249 #define mpi_bcast_ mpi_bcast__ 250 #define mpi_gather_ mpi_gather__ 251 #define mpi_allgather_ mpi_allgather__ 252 #define mpi_comm_split_ mpi_comm_split__ 253 #define mpi_scan mpi_scan__ 254 #define mpi_send_ mpi_send__ 255 #define mpi_recv_ mpi_recv__ 256 #define mpi_reduce_scatter_ mpi_reduce_scatter__ 257 #define mpi_irecv_ mpi_irecv__ 258 #define mpi_isend_ mpi_isend__ 259 #define mpi_sendrecv_ mpi_sendrecv__ 260 #define mpi_test_ mpi_test__ 261 #define mpi_waitall_ mpi_waitall__ 262 #define mpi_waitany_ mpi_waitany__ 263 #define mpi_allgatherv_ mpi_allgatherv__ 264 #define mpi_alltoallv_ mpi_alltoallv__ 265 #define mpi_comm_create_ mpi_comm_create__ 266 #define mpi_address_ mpi_address__ 267 #define mpi_pack_ mpi_pack__ 268 #define mpi_unpack_ mpi_unpack__ 269 #define mpi_pack_size_ mpi_pack_size__ 270 #define mpi_type_struct_ mpi_type_struct__ 271 #define mpi_type_commit_ mpi_type_commit__ 272 #define mpi_wtime_ mpi_wtime__ 273 #endif 274 275 276 /* Do not build fortran interface if MPI namespace colision is to be avoided */ 277 #if !defined(MPIUNI_AVOID_MPI_NAMESPACE) 278 279 void PETSC_STDCALL mpi_init_(int *ierr) 280 { 281 *ierr = MPI_Init((int*)0, (char***)0); 282 } 283 284 void PETSC_STDCALL mpi_finalize_(int *ierr) 285 { 286 *ierr = MPI_Finalize(); 287 } 288 289 void PETSC_STDCALL mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr) 290 { 291 *size = 1; 292 *ierr = 0; 293 } 294 295 void PETSC_STDCALL mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr) 296 { 297 *rank=0; 298 *ierr=MPI_SUCCESS; 299 } 300 301 void PETSC_STDCALL mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr) 302 { 303 *newcomm = *comm; 304 *ierr=MPI_SUCCESS; 305 } 306 307 void PETSC_STDCALL mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr) 308 { 309 abort(); 310 *ierr = MPI_SUCCESS; 311 } 312 313 void PETSC_STDCALL mpi_reduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *root,int *comm,int *ierr) 314 { 315 MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]); 316 *ierr = MPI_SUCCESS; 317 } 318 319 void PETSC_STDCALL mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 320 { 321 MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]); 322 *ierr = MPI_SUCCESS; 323 } 324 325 void PETSC_STDCALL mpi_barrier_(MPI_Comm *comm,int *ierr) 326 { 327 *ierr = MPI_SUCCESS; 328 } 329 330 void PETSC_STDCALL mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr) 331 { 332 *ierr = MPI_SUCCESS; 333 } 334 335 336 void PETSC_STDCALL mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype, int *root,int *comm,int *ierr) 337 { 338 MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]); 339 *ierr = MPI_SUCCESS; 340 } 341 342 void PETSC_STDCALL mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void* recvbuf, int* rcount, int* rdatatype,int *comm,int *ierr) 343 { 344 MPIUNI_Memcpy(recvbuf,sendbuf,(*scount)*MPIUNI_DATASIZE[*sdatatype]); 345 *ierr = MPI_SUCCESS; 346 } 347 348 void PETSC_STDCALL mpi_scan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 349 { 350 MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPIUNI_DATASIZE[*datatype]); 351 *ierr = MPI_SUCCESS; 352 } 353 354 void PETSC_STDCALL mpi_send_(void*buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr ) 355 { 356 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 357 } 358 359 void PETSC_STDCALL mpi_recv_(void*buf,int *count,int *datatype,int *source,int *tag,int *comm,int status,int *ierr ) 360 { 361 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 362 } 363 364 void PETSC_STDCALL mpi_reduce_scatter_(void*sendbuf,void*recvbuf,int *recvcounts,int *datatype,int *op,int *comm,int *ierr) 365 { 366 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 367 } 368 369 void PETSC_STDCALL mpi_irecv_(void*buf,int *count, int *datatype, int *source, int *tag, int *comm, int *request, int *ierr) 370 { 371 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 372 } 373 374 void PETSC_STDCALL mpi_isend_(void*buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *request, int *ierr) 375 { 376 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 377 } 378 379 void PETSC_STDCALL mpi_sendrecv_(void*sendbuf,int *sendcount,int *sendtype,int *dest,int *sendtag,void*recvbuf,int *recvcount,int *recvtype,int *source,int *recvtag,int *comm,int *status,int *ierr) 380 { 381 MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPIUNI_DATASIZE[*sendtype]); 382 *ierr = MPI_SUCCESS; 383 } 384 385 void PETSC_STDCALL mpi_test_(int *request,int *flag,int *status,int *ierr) 386 { 387 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 388 } 389 390 void PETSC_STDCALL mpi_waitall_(int *count,int *array_of_requests,int *array_of_statuses,int *ierr) 391 { 392 *ierr = MPI_SUCCESS; 393 } 394 395 void PETSC_STDCALL mpi_waitany_(int *count,int *array_of_requests,int * index, int *status,int *ierr) 396 { 397 *ierr = MPI_SUCCESS; 398 } 399 400 void PETSC_STDCALL mpi_allgatherv_(void*sendbuf,int *sendcount,int *sendtype,void*recvbuf,int *recvcounts,int *displs,int *recvtype,int *comm,int *ierr) 401 { 402 MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPIUNI_DATASIZE[*sendtype]); 403 *ierr = MPI_SUCCESS; 404 } 405 406 void PETSC_STDCALL mpi_alltoallv_(void*sendbuf,int *sendcounts,int *sdispls,int *sendtype,void*recvbuf,int *recvcounts,int *rdispls,int *recvtype,int *comm,int *ierr) 407 { 408 MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcounts)*MPIUNI_DATASIZE[*sendtype]); 409 *ierr = MPI_SUCCESS; 410 } 411 412 void PETSC_STDCALL mpi_comm_create_(int *comm,int *group,int *newcomm,int *ierr) 413 { 414 *newcomm = *comm; 415 *ierr = MPI_SUCCESS; 416 } 417 418 void PETSC_STDCALL mpi_address_(void*location,int *address,int *ierr) 419 { 420 *address = (int) location; 421 *ierr = MPI_SUCCESS; 422 } 423 424 void PETSC_STDCALL mpi_pack_(void*inbuf,int *incount,int *datatype,void*outbuf,int *outsize,int *position,int *comm,int *ierr) 425 { 426 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 427 } 428 429 void PETSC_STDCALL mpi_unpack_(void*inbuf,int *insize,int *position,void*outbuf,int *outcount,int *datatype,int *comm,int *ierr) 430 { 431 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 432 } 433 434 void PETSC_STDCALL mpi_pack_size_(int *incount,int *datatype,int *comm,int *size,int *ierr) 435 { 436 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 437 } 438 439 void PETSC_STDCALL mpi_type_struct_(int *count,int *array_of_blocklengths,int * array_of_displaments,int *array_of_types,int *newtype,int *ierr) 440 { 441 *ierr = MPI_Abort(MPI_COMM_WORLD,0); 442 } 443 444 void PETSC_STDCALL mpi_type_commit_(int *datatype,int *ierr) 445 { 446 *ierr = MPI_SUCCESS; 447 } 448 449 double PETSC_STDCALL mpi_wtime_(void) 450 { 451 return 0.0; 452 453 } 454 455 #endif /* MPIUNI_AVOID_MPI_NAMESPACE */ 456 457 #if defined(__cplusplus) 458 } 459 #endif 460