1 /* 2 This provides a few of the MPI-uni functions that cannot be implemented 3 with C macros 4 */ 5 #include <petscsys.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 13 #define MPI_SUCCESS 0 14 #define MPI_FAILURE 1 15 16 void *MPIUNI_TMP = NULL; 17 18 /* 19 With MPI Uni there are exactly four distinct communicators: 20 MPI_COMM_SELF, MPI_COMM_WORLD, and a MPI_Comm_dup() of each of these (duplicates of duplicates return the same communictor) 21 22 MPI_COMM_SELF and MPI_COMM_WORLD are MPI_Comm_free() in MPI_Finalize() but in general with PETSc, 23 the other communicators are freed once the last PETSc object is freed (before MPI_Finalize()). 24 25 */ 26 #define MAX_ATTR 128 27 #define MAX_COMM 128 28 29 static int MaxComm = 2; 30 31 typedef struct { 32 void *attribute_val; 33 int active; 34 } MPI_Attr; 35 36 typedef struct { 37 void *extra_state; 38 MPI_Delete_function *del; 39 } MPI_Attr_keyval; 40 41 static MPI_Attr_keyval attr_keyval[MAX_ATTR]; 42 static MPI_Attr attr[MAX_COMM][MAX_ATTR]; 43 static int comm_active[MAX_COMM]; 44 static int num_attr = 1,mpi_tag_ub = 100000000; 45 static void* MPIUNIF_mpi_in_place = 0; 46 47 #if defined(__cplusplus) 48 extern "C" { 49 #endif 50 51 /* 52 To avoid problems with prototypes to the system memcpy() it is duplicated here 53 */ 54 int MPIUNI_Memcpy(void *a,const void *b,int n) 55 { 56 int i; 57 char *aa= (char*)a; 58 char *bb= (char*)b; 59 60 if (a == MPI_IN_PLACE || a == MPIUNIF_mpi_in_place) return MPI_SUCCESS; 61 if (b == MPI_IN_PLACE || b == MPIUNIF_mpi_in_place) return MPI_SUCCESS; 62 for (i=0; i<n; i++) aa[i] = bb[i]; 63 return MPI_SUCCESS; 64 } 65 66 static int classcnt = 0; 67 static int codecnt = 0; 68 69 int MPI_Add_error_class(int *cl) 70 { 71 *cl = classcnt++; 72 return MPI_SUCCESS; 73 } 74 75 int MPI_Add_error_code(int cl,int *co) 76 { 77 if (cl >= classcnt) return MPI_FAILURE; 78 *co = codecnt++; 79 return MPI_SUCCESS; 80 } 81 82 int MPI_Type_get_envelope(MPI_Datatype datatype,int *num_integers,int *num_addresses,int *num_datatypes,int *combiner) 83 { 84 int comb = datatype >> 28; 85 switch (comb) { 86 case MPI_COMBINER_NAMED: 87 *num_integers = 0; 88 *num_addresses = 0; 89 *num_datatypes = 0; 90 *combiner = comb; 91 break; 92 case MPI_COMBINER_DUP: 93 *num_integers = 0; 94 *num_addresses = 0; 95 *num_datatypes = 1; 96 *combiner = comb; 97 break; 98 case MPI_COMBINER_CONTIGUOUS: 99 *num_integers = 1; 100 *num_addresses = 0; 101 *num_datatypes = 1; 102 *combiner = comb; 103 break; 104 default: 105 return MPIUni_Abort(MPI_COMM_SELF,1); 106 } 107 return MPI_SUCCESS; 108 } 109 110 int MPI_Type_get_contents(MPI_Datatype datatype,int max_integers,int max_addresses,int max_datatypes,int *array_of_integers,MPI_Aint *array_of_addresses,MPI_Datatype *array_of_datatypes) 111 { 112 int comb = datatype >> 28; 113 switch (comb) { 114 case MPI_COMBINER_NAMED: 115 return MPIUni_Abort(MPI_COMM_SELF,1); 116 break; 117 case MPI_COMBINER_DUP: 118 if (max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1); 119 array_of_datatypes[0] = datatype & 0x0fffffff; 120 break; 121 case MPI_COMBINER_CONTIGUOUS: 122 if (max_integers < 1 || max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1); 123 array_of_integers[0] = (datatype >> 8) & 0xfff; /* count */ 124 array_of_datatypes[0] = (datatype & 0x0ff000ff) | 0x100; /* basic named type (count=1) from which the contiguous type is derived */ 125 break; 126 default: 127 return MPIUni_Abort(MPI_COMM_SELF,1); 128 } 129 return MPI_SUCCESS; 130 } 131 132 /* 133 Used to set the built-in MPI_TAG_UB attribute 134 */ 135 static int Keyval_setup(void) 136 { 137 attr[MPI_COMM_WORLD-1][0].active = 1; 138 attr[MPI_COMM_WORLD-1][0].attribute_val = &mpi_tag_ub; 139 attr[MPI_COMM_SELF-1][0].active = 1; 140 attr[MPI_COMM_SELF-1][0].attribute_val = &mpi_tag_ub; 141 return MPI_SUCCESS; 142 } 143 144 int MPI_Comm_create_keyval(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state) 145 { 146 if (num_attr >= MAX_ATTR) return MPIUni_Abort(MPI_COMM_WORLD,1); 147 148 attr_keyval[num_attr].extra_state = extra_state; 149 attr_keyval[num_attr].del = delete_fn; 150 *keyval = num_attr++; 151 return MPI_SUCCESS; 152 } 153 154 int MPI_Comm_free_keyval(int *keyval) 155 { 156 attr_keyval[*keyval].extra_state = 0; 157 attr_keyval[*keyval].del = 0; 158 159 *keyval = 0; 160 return MPI_SUCCESS; 161 } 162 163 int MPI_Comm_set_attr(MPI_Comm comm,int keyval,void *attribute_val) 164 { 165 if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE; 166 attr[comm-1][keyval].active = 1; 167 attr[comm-1][keyval].attribute_val = attribute_val; 168 return MPI_SUCCESS; 169 } 170 171 int MPI_Comm_delete_attr(MPI_Comm comm,int keyval) 172 { 173 if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE; 174 if (attr[comm-1][keyval].active && attr_keyval[keyval].del) { 175 void *save_attribute_val = attr[comm-1][keyval].attribute_val; 176 attr[comm-1][keyval].active = 0; 177 attr[comm-1][keyval].attribute_val = 0; 178 (*(attr_keyval[keyval].del))(comm,keyval,save_attribute_val,attr_keyval[keyval].extra_state); 179 } 180 return MPI_SUCCESS; 181 } 182 183 int MPI_Comm_get_attr(MPI_Comm comm,int keyval,void *attribute_val,int *flag) 184 { 185 if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE; 186 if (!keyval) Keyval_setup(); 187 *flag = attr[comm-1][keyval].active; 188 *(void**)attribute_val = attr[comm-1][keyval].attribute_val; 189 return MPI_SUCCESS; 190 } 191 192 int MPI_Comm_create(MPI_Comm comm,MPI_Group group,MPI_Comm *newcomm) 193 { 194 int j; 195 if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE; 196 for (j=3; j<MaxComm; j++) { 197 if (!comm_active[j-1]) { 198 comm_active[j-1] = 1; 199 *newcomm = j; 200 return MPI_SUCCESS; 201 } 202 } 203 if (MaxComm > MAX_COMM) return MPI_FAILURE; 204 *newcomm = MaxComm++; 205 comm_active[*newcomm-1] = 1; 206 return MPI_SUCCESS; 207 } 208 209 int MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out) 210 { 211 int j; 212 if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE; 213 for (j=3; j<MaxComm; j++) { 214 if (!comm_active[j-1]) { 215 comm_active[j-1] = 1; 216 *out = j; 217 return MPI_SUCCESS; 218 } 219 } 220 if (MaxComm > MAX_COMM) return MPI_FAILURE; 221 *out = MaxComm++; 222 comm_active[*out-1] = 1; 223 return MPI_SUCCESS; 224 } 225 226 int MPI_Comm_free(MPI_Comm *comm) 227 { 228 int i; 229 230 if (*comm-1 < 0 || *comm-1 > MaxComm) return MPI_FAILURE; 231 for (i=0; i<num_attr; i++) { 232 if (attr[*comm-1][i].active && attr_keyval[i].del) (*attr_keyval[i].del)(*comm,i,attr[*comm-1][i].attribute_val,attr_keyval[i].extra_state); 233 attr[*comm-1][i].active = 0; 234 attr[*comm-1][i].attribute_val = 0; 235 } 236 if (*comm >= 3) comm_active[*comm-1] = 0; 237 *comm = 0; 238 return MPI_SUCCESS; 239 } 240 241 int MPI_Comm_size(MPI_Comm comm, int *size) 242 { 243 if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE; 244 *size=1; 245 return MPI_SUCCESS; 246 } 247 248 int MPI_Comm_rank(MPI_Comm comm, int *rank) 249 { 250 if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE; 251 *rank=0; 252 return MPI_SUCCESS; 253 } 254 255 int MPIUni_Abort(MPI_Comm comm,int errorcode) 256 { 257 printf("MPI operation not supported by PETSc's sequential MPI wrappers\n"); 258 return MPI_FAILURE; 259 } 260 261 int MPI_Abort(MPI_Comm comm,int errorcode) 262 { 263 abort(); 264 return MPI_SUCCESS; 265 } 266 267 /* --------------------------------------------------------------------------*/ 268 269 static int MPI_was_initialized = 0; 270 static int MPI_was_finalized = 0; 271 272 int MPI_Init(int *argc, char ***argv) 273 { 274 if (MPI_was_initialized) return MPI_FAILURE; 275 if (MPI_was_finalized) return MPI_FAILURE; 276 MPI_was_initialized = 1; 277 return MPI_SUCCESS; 278 } 279 280 int MPI_Finalize(void) 281 { 282 MPI_Comm comm; 283 if (MPI_was_finalized) return MPI_FAILURE; 284 if (!MPI_was_initialized) return MPI_FAILURE; 285 comm = MPI_COMM_WORLD; 286 MPI_Comm_free(&comm); 287 comm = MPI_COMM_SELF; 288 MPI_Comm_free(&comm); 289 MPI_was_finalized = 1; 290 return MPI_SUCCESS; 291 } 292 293 int MPI_Initialized(int *flag) 294 { 295 *flag = MPI_was_initialized; 296 return MPI_SUCCESS; 297 } 298 299 int MPI_Finalized(int *flag) 300 { 301 *flag = MPI_was_finalized; 302 return MPI_SUCCESS; 303 } 304 305 /* ------------------- Fortran versions of several routines ------------------ */ 306 307 #if defined(PETSC_HAVE_FORTRAN_CAPS) 308 #define mpiunisetcommonblock_ MPIUNISETCOMMONBLOCK 309 #define mpiunisetfortranbasepointers_ MPIUNISETFORTRANBASEPOINTERS 310 #define petsc_mpi_init_ PETSC_MPI_INIT 311 #define petsc_mpi_finalize_ PETSC_MPI_FINALIZE 312 #define petsc_mpi_comm_size_ PETSC_MPI_COMM_SIZE 313 #define petsc_mpi_comm_rank_ PETSC_MPI_COMM_RANK 314 #define petsc_mpi_abort_ PETSC_MPI_ABORT 315 #define petsc_mpi_reduce_ PETSC_MPI_REDUCE 316 #define petsc_mpi_allreduce_ PETSC_MPI_ALLREDUCE 317 #define petsc_mpi_barrier_ PETSC_MPI_BARRIER 318 #define petsc_mpi_bcast_ PETSC_MPI_BCAST 319 #define petsc_mpi_gather_ PETSC_MPI_GATHER 320 #define petsc_mpi_allgather_ PETSC_MPI_ALLGATHER 321 #define petsc_mpi_comm_split_ PETSC_MPI_COMM_SPLIT 322 #define petsc_mpi_scan_ PETSC_MPI_SCAN 323 #define petsc_mpi_send_ PETSC_MPI_SEND 324 #define petsc_mpi_recv_ PETSC_MPI_RECV 325 #define petsc_mpi_reduce_scatter_ PETSC_MPI_REDUCE_SCATTER 326 #define petsc_mpi_irecv_ PETSC_MPI_IRECV 327 #define petsc_mpi_isend_ PETSC_MPI_ISEND 328 #define petsc_mpi_sendrecv_ PETSC_MPI_SENDRECV 329 #define petsc_mpi_test_ PETSC_MPI_TEST 330 #define petsc_mpi_waitall_ PETSC_MPI_WAITALL 331 #define petsc_mpi_waitany_ PETSC_MPI_WAITANY 332 #define petsc_mpi_allgatherv_ PETSC_MPI_ALLGATHERV 333 #define petsc_mpi_alltoallv_ PETSC_MPI_ALLTOALLV 334 #define petsc_mpi_comm_create_ PETSC_MPI_COMM_CREATE 335 #define petsc_mpi_address_ PETSC_MPI_ADDRESS 336 #define petsc_mpi_pack_ PETSC_MPI_PACK 337 #define petsc_mpi_unpack_ PETSC_MPI_UNPACK 338 #define petsc_mpi_pack_size_ PETSC_MPI_PACK_SIZE 339 #define petsc_mpi_type_struct_ PETSC_MPI_TYPE_STRUCT 340 #define petsc_mpi_type_commit_ PETSC_MPI_TYPE_COMMIT 341 #define petsc_mpi_wtime_ PETSC_MPI_WTIME 342 #define petsc_mpi_cancel_ PETSC_MPI_CANCEL 343 #define petsc_mpi_comm_dup_ PETSC_MPI_COMM_DUP 344 #define petsc_mpi_comm_free_ PETSC_MPI_COMM_FREE 345 #define petsc_mpi_get_count_ PETSC_MPI_GET_COUNT 346 #define petsc_mpi_get_processor_name_ PETSC_MPI_GET_PROCESSOR_NAME 347 #define petsc_mpi_initialized_ PETSC_MPI_INITIALIZED 348 #define petsc_mpi_iprobe_ PETSC_MPI_IPROBE 349 #define petsc_mpi_probe_ PETSC_MPI_PROBE 350 #define petsc_mpi_request_free_ PETSC_MPI_REQUEST_FREE 351 #define petsc_mpi_ssend_ PETSC_MPI_SSEND 352 #define petsc_mpi_wait_ PETSC_MPI_WAIT 353 #define petsc_mpi_comm_group_ PETSC_MPI_COMM_GROUP 354 #define petsc_mpi_exscan_ PETSC_MPI_EXSCAN 355 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 356 #define mpiunisetcommonblock_ mpiunisetcommonblock 357 #define mpiunisetfortranbasepointers_ mpiunisetfortranbasepointers 358 #define petsc_mpi_init_ petsc_mpi_init 359 #define petsc_mpi_finalize_ petsc_mpi_finalize 360 #define petsc_mpi_comm_size_ petsc_mpi_comm_size 361 #define petsc_mpi_comm_rank_ petsc_mpi_comm_rank 362 #define petsc_mpi_abort_ petsc_mpi_abort 363 #define petsc_mpi_reduce_ petsc_mpi_reduce 364 #define petsc_mpi_allreduce_ petsc_mpi_allreduce 365 #define petsc_mpi_barrier_ petsc_mpi_barrier 366 #define petsc_mpi_bcast_ petsc_mpi_bcast 367 #define petsc_mpi_gather_ petsc_mpi_gather 368 #define petsc_mpi_allgather_ petsc_mpi_allgather 369 #define petsc_mpi_comm_split_ petsc_mpi_comm_split 370 #define petsc_mpi_scan_ petsc_mpi_scan 371 #define petsc_mpi_send_ petsc_mpi_send 372 #define petsc_mpi_recv_ petsc_mpi_recv 373 #define petsc_mpi_reduce_scatter_ petsc_mpi_reduce_scatter 374 #define petsc_mpi_irecv_ petsc_mpi_irecv 375 #define petsc_mpi_isend_ petsc_mpi_isend 376 #define petsc_mpi_sendrecv_ petsc_mpi_sendrecv 377 #define petsc_mpi_test_ petsc_mpi_test 378 #define petsc_mpi_waitall_ petsc_mpi_waitall 379 #define petsc_mpi_waitany_ petsc_mpi_waitany 380 #define petsc_mpi_allgatherv_ petsc_mpi_allgatherv 381 #define petsc_mpi_alltoallv_ petsc_mpi_alltoallv 382 #define petsc_mpi_comm_create_ petsc_mpi_comm_create 383 #define petsc_mpi_address_ petsc_mpi_address 384 #define petsc_mpi_pack_ petsc_mpi_pack 385 #define petsc_mpi_unpack_ petsc_mpi_unpack 386 #define petsc_mpi_pack_size_ petsc_mpi_pack_size 387 #define petsc_mpi_type_struct_ petsc_mpi_type_struct 388 #define petsc_mpi_type_commit_ petsc_mpi_type_commit 389 #define petsc_mpi_wtime_ petsc_mpi_wtime 390 #define petsc_mpi_cancel_ petsc_mpi_cancel 391 #define petsc_mpi_comm_dup_ petsc_mpi_comm_dup 392 #define petsc_mpi_comm_free_ petsc_mpi_comm_free 393 #define petsc_mpi_get_count_ petsc_mpi_get_count 394 #define petsc_mpi_get_processor_name_ petsc_mpi_get_processor_name 395 #define petsc_mpi_initialized_ petsc_mpi_initialized 396 #define petsc_mpi_iprobe_ petsc_mpi_iprobe 397 #define petsc_mpi_probe_ petsc_mpi_probe 398 #define petsc_mpi_request_free_ petsc_mpi_request_free 399 #define petsc_mpi_ssend_ petsc_mpi_ssend 400 #define petsc_mpi_wait_ petsc_mpi_wait 401 #define petsc_mpi_comm_group_ petsc_mpi_comm_group 402 #define petsc_mpi_exscan_ petsc_mpi_exscan 403 #endif 404 405 #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE) 406 #define petsc_mpi_init_ petsc_mpi_init__ 407 #define petsc_mpi_finalize_ petsc_mpi_finalize__ 408 #define petsc_mpi_comm_size_ petsc_mpi_comm_size__ 409 #define petsc_mpi_comm_rank_ petsc_mpi_comm_rank__ 410 #define petsc_mpi_abort_ petsc_mpi_abort__ 411 #define petsc_mpi_reduce_ petsc_mpi_reduce__ 412 #define petsc_mpi_allreduce_ petsc_mpi_allreduce__ 413 #define petsc_mpi_barrier_ petsc_mpi_barrier__ 414 #define petsc_mpi_bcast_ petsc_mpi_bcast__ 415 #define petsc_mpi_gather_ petsc_mpi_gather__ 416 #define petsc_mpi_allgather_ petsc_mpi_allgather__ 417 #define petsc_mpi_comm_split_ petsc_mpi_comm_split__ 418 #define petsc_mpi_scan_ petsc_mpi_scan__ 419 #define petsc_mpi_send_ petsc_mpi_send__ 420 #define petsc_mpi_recv_ petsc_mpi_recv__ 421 #define petsc_mpi_reduce_scatter_ petsc_mpi_reduce_scatter__ 422 #define petsc_mpi_irecv_ petsc_mpi_irecv__ 423 #define petsc_mpi_isend_ petsc_mpi_isend__ 424 #define petsc_mpi_sendrecv_ petsc_mpi_sendrecv__ 425 #define petsc_mpi_test_ petsc_mpi_test__ 426 #define petsc_mpi_waitall_ petsc_mpi_waitall__ 427 #define petsc_mpi_waitany_ petsc_mpi_waitany__ 428 #define petsc_mpi_allgatherv_ petsc_mpi_allgatherv__ 429 #define petsc_mpi_alltoallv_ petsc_mpi_alltoallv__ 430 #define petsc_mpi_comm_create_ petsc_mpi_comm_create__ 431 #define petsc_mpi_address_ petsc_mpi_address__ 432 #define petsc_mpi_pack_ petsc_mpi_pack__ 433 #define petsc_mpi_unpack_ petsc_mpi_unpack__ 434 #define petsc_mpi_pack_size_ petsc_mpi_pack_size__ 435 #define petsc_mpi_type_struct_ petsc_mpi_type_struct__ 436 #define petsc_mpi_type_commit_ petsc_mpi_type_commit__ 437 #define petsc_mpi_wtime_ petsc_mpi_wtime__ 438 #define petsc_mpi_cancel_ petsc_mpi_cancel__ 439 #define petsc_mpi_comm_dup_ petsc_mpi_comm_dup__ 440 #define petsc_mpi_comm_free_ petsc_mpi_comm_free__ 441 #define petsc_mpi_get_count_ petsc_mpi_get_count__ 442 #define petsc_mpi_get_processor_name_ petsc_mpi_get_processor_name__ 443 #define petsc_mpi_initialized_ petsc_mpi_initialized__ 444 #define petsc_mpi_iprobe_ petsc_mpi_iprobe__ 445 #define petsc_mpi_probe_ petsc_mpi_probe__ 446 #define petsc_mpi_request_free_ petsc_mpi_request_free__ 447 #define petsc_mpi_ssend_ petsc_mpi_ssend__ 448 #define petsc_mpi_wait_ petsc_mpi_wait__ 449 #define petsc_mpi_comm_group_ petsc_mpi_comm_group__ 450 #define petsc_mpi_exscan_ petsc_mpi_exscan__ 451 #endif 452 453 /* Do not build fortran interface if MPI namespace colision is to be avoided */ 454 #if defined(PETSC_HAVE_FORTRAN) 455 456 PETSC_EXTERN void PETSC_STDCALL mpiunisetcommonblock_(void); 457 458 PETSC_EXTERN void PETSC_STDCALL mpiunisetfortranbasepointers_(void *f_mpi_in_place) 459 { 460 MPIUNIF_mpi_in_place = f_mpi_in_place; 461 } 462 463 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_init_(int *ierr) 464 { 465 mpiunisetcommonblock_(); 466 *ierr = MPI_Init((int*)0, (char***)0); 467 } 468 469 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_finalize_(int *ierr) 470 { 471 *ierr = MPI_Finalize(); 472 } 473 474 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr) 475 { 476 *size = 1; 477 *ierr = 0; 478 } 479 480 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr) 481 { 482 *rank = 0; 483 *ierr = MPI_SUCCESS; 484 } 485 486 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr) 487 { 488 *newcomm = *comm; 489 *ierr = MPI_SUCCESS; 490 } 491 492 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr) 493 { 494 abort(); 495 *ierr = MPI_SUCCESS; 496 } 497 498 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_reduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *root,int *comm,int *ierr) 499 { 500 *ierr = MPI_Reduce(sendbuf,recvbuf,*count,*datatype,*op,*root,*comm); 501 } 502 503 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 504 { 505 *ierr = MPI_Allreduce(sendbuf,recvbuf,*count,*datatype,*op,*comm); 506 } 507 508 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_barrier_(MPI_Comm *comm,int *ierr) 509 { 510 *ierr = MPI_SUCCESS; 511 } 512 513 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr) 514 { 515 *ierr = MPI_SUCCESS; 516 } 517 518 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype, int *root,int *comm,int *ierr) 519 { 520 *ierr = MPI_Gather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*root,*comm); 521 } 522 523 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype,int *comm,int *ierr) 524 { 525 *ierr = MPI_Allgather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*comm); 526 } 527 528 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_scan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 529 { 530 *ierr = MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPI_sizeof(*datatype)); 531 } 532 533 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_send_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr) 534 { 535 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 536 } 537 538 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_recv_(void *buf,int *count,int *datatype,int *source,int *tag,int *comm,int status,int *ierr) 539 { 540 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 541 } 542 543 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_reduce_scatter_(void *sendbuf,void *recvbuf,int *recvcounts,int *datatype,int *op,int *comm,int *ierr) 544 { 545 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 546 } 547 548 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_irecv_(void *buf,int *count, int *datatype, int *source, int *tag, int *comm, int *request, int *ierr) 549 { 550 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 551 } 552 553 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_isend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *request, int *ierr) 554 { 555 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 556 } 557 558 PETSC_EXTERN void PETSC_STDCALL petsc_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) 559 { 560 *ierr = MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPI_sizeof(*sendtype)); 561 } 562 563 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_test_(int *request,int *flag,int *status,int *ierr) 564 { 565 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 566 } 567 568 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_waitall_(int *count,int *array_of_requests,int *array_of_statuses,int *ierr) 569 { 570 *ierr = MPI_SUCCESS; 571 } 572 573 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_waitany_(int *count,int *array_of_requests,int * index, int *status,int *ierr) 574 { 575 *ierr = MPI_SUCCESS; 576 } 577 578 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allgatherv_(void *sendbuf,int *sendcount,int *sendtype,void *recvbuf,int *recvcounts,int *displs,int *recvtype,int *comm,int *ierr) 579 { 580 *ierr = MPI_Allgatherv(sendbuf,*sendcount,*sendtype,recvbuf,recvcounts,displs,*recvtype,*comm); 581 } 582 583 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_alltoallv_(void *sendbuf,int *sendcounts,int *sdispls,int *sendtype,void *recvbuf,int *recvcounts,int *rdispls,int *recvtype,int *comm,int *ierr) 584 { 585 *ierr = MPI_Alltoallv(sendbuf,sendcounts,sdispls,*sendtype,recvbuf,recvcounts,rdispls,*recvtype,*comm); 586 } 587 588 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_create_(int *comm,int *group,int *newcomm,int *ierr) 589 { 590 *newcomm = *comm; 591 *ierr = MPI_SUCCESS; 592 } 593 594 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_address_(void *location,MPI_Aint *address,int *ierr) 595 { 596 *address = (MPI_Aint) ((char *)location); 597 *ierr = MPI_SUCCESS; 598 } 599 600 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_pack_(void *inbuf,int *incount,int *datatype,void *outbuf,int *outsize,int *position,int *comm,int *ierr) 601 { 602 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 603 } 604 605 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_unpack_(void *inbuf,int *insize,int *position,void *outbuf,int *outcount,int *datatype,int *comm,int *ierr) 606 { 607 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 608 } 609 610 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_pack_size_(int *incount,int *datatype,int *comm,int *size,int *ierr) 611 { 612 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 613 } 614 615 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_type_struct_(int *count,int *array_of_blocklengths,int * array_of_displaments,int *array_of_types,int *newtype,int *ierr) 616 { 617 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 618 } 619 620 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_type_commit_(int *datatype,int *ierr) 621 { 622 *ierr = MPI_SUCCESS; 623 } 624 625 double PETSC_STDCALL petsc_mpi_wtime_(void) 626 { 627 return 0.0; 628 } 629 630 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_cancel_(int *request,int *ierr) 631 { 632 *ierr = MPI_SUCCESS; 633 } 634 635 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_dup_(int *comm,int *out,int *ierr) 636 { 637 *out = *comm; 638 *ierr = MPI_SUCCESS; 639 } 640 641 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_free_(int *comm,int *ierr) 642 { 643 *ierr = MPI_SUCCESS; 644 } 645 646 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_get_count_(int *status,int *datatype,int *count,int *ierr) 647 { 648 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 649 } 650 651 /* duplicate from fortranimpl.h */ 652 #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG) 653 #define PETSC_MIXED_LEN(len) ,int len 654 #define PETSC_END_LEN(len) 655 #else 656 #define PETSC_MIXED_LEN(len) 657 #define PETSC_END_LEN(len) ,int len 658 #endif 659 660 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_get_processor_name_(char *name PETSC_MIXED_LEN(len),int *result_len,int *ierr PETSC_END_LEN(len)) 661 { 662 MPIUNI_Memcpy(name,"localhost",9*sizeof(char)); 663 *result_len = 9; 664 *ierr = MPI_SUCCESS; 665 } 666 667 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_initialized_(int *flag,int *ierr) 668 { 669 *flag = MPI_was_initialized; 670 *ierr = MPI_SUCCESS; 671 } 672 673 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_iprobe_(int *source,int *tag,int *comm,int *glag,int *status,int *ierr) 674 { 675 *ierr = MPI_SUCCESS; 676 } 677 678 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_probe_(int *source,int *tag,int *comm,int *flag,int *status,int *ierr) 679 { 680 *ierr = MPI_SUCCESS; 681 } 682 683 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_request_free_(int *request,int *ierr) 684 { 685 *ierr = MPI_SUCCESS; 686 } 687 688 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_ssend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr) 689 { 690 *ierr = MPIUni_Abort(MPI_COMM_WORLD,0); 691 } 692 693 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_wait_(int *request,int *status,int *ierr) 694 { 695 *ierr = MPI_SUCCESS; 696 } 697 698 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_group_(int *comm,int *group,int *ierr) 699 { 700 *ierr = MPI_SUCCESS; 701 } 702 703 PETSC_EXTERN void PETSC_STDCALL petsc_mpi_exscan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr) 704 { 705 *ierr = MPI_SUCCESS; 706 } 707 708 #endif /* PETSC_HAVE_FORTRAN */ 709 710 #if defined(__cplusplus) 711 } 712 #endif 713