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