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