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