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