Actual source code: mpi.c
petsc-3.10.5 2019-03-28
Report Typos and Errors

      1: /*
      2:       This provides a few of the MPI-uni functions that cannot be implemented
      3:     with C macros
      4: */
      5:  #include <petscsys.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

     13: #define MPI_SUCCESS 0
     14: #define MPI_FAILURE 1

     16: void *MPIUNI_TMP = NULL;

     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)

     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()).

     25: */
     26: #define MAX_ATTR 128
     27: #define MAX_COMM 128

     29: static int MaxComm = 2;

     31: typedef struct {
     32:   void *attribute_val;
     33:   int  active;
     34: } MPI_Attr;

     36: typedef struct {
     37:   void                *extra_state;
     38:   MPI_Delete_function *del;
     39: } MPI_Attr_keyval;

     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;

     47: #if defined(__cplusplus)
     48: extern "C" {
     49: #endif

     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;

     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: }

     66: static int classcnt = 0;
     67: static int codecnt = 0;

     69: int MPI_Add_error_class(int *cl)
     70: {
     71:   *cl = classcnt++;
     72:   return MPI_SUCCESS;
     73: }

     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: }

     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: }

    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: }

    132: /*
    133:    Used to set the built-in MPI_TAG_UB attribute
    134: */
    135: static int Keyval_setup(void)
    136: {
    137:   attr[MPI_COMM_WORLD-1][0].active        = 1;
    138:   attr[MPI_COMM_WORLD-1][0].attribute_val = &mpi_tag_ub;
    139:   attr[MPI_COMM_SELF-1][0].active         = 1;
    140:   attr[MPI_COMM_SELF-1][0].attribute_val  = &mpi_tag_ub;
    141:   return MPI_SUCCESS;
    142: }

    144: int MPI_Comm_create_keyval(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
    145: {
    146:   if (num_attr >= MAX_ATTR) return MPIUni_Abort(MPI_COMM_WORLD,1);

    148:   attr_keyval[num_attr].extra_state = extra_state;
    149:   attr_keyval[num_attr].del         = delete_fn;
    150:   *keyval                           = num_attr++;
    151:   return MPI_SUCCESS;
    152: }

    154: int MPI_Comm_free_keyval(int *keyval)
    155: {
    156:   attr_keyval[*keyval].extra_state = 0;
    157:   attr_keyval[*keyval].del         = 0;

    159:   *keyval = 0;
    160:   return MPI_SUCCESS;
    161: }

    163: int MPI_Comm_set_attr(MPI_Comm comm,int keyval,void *attribute_val)
    164: {
    165:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
    166:   attr[comm-1][keyval].active        = 1;
    167:   attr[comm-1][keyval].attribute_val = attribute_val;
    168:   return MPI_SUCCESS;
    169: }

    171: int MPI_Comm_delete_attr(MPI_Comm comm,int keyval)
    172: {
    173:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
    174:   if (attr[comm-1][keyval].active && attr_keyval[keyval].del) {
    175:     void *save_attribute_val = attr[comm-1][keyval].attribute_val;
    176:     attr[comm-1][keyval].active        = 0;
    177:     attr[comm-1][keyval].attribute_val = 0;
    178:     (*(attr_keyval[keyval].del))(comm,keyval,save_attribute_val,attr_keyval[keyval].extra_state);
    179:   }
    180:   return MPI_SUCCESS;
    181: }

    183: int MPI_Comm_get_attr(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
    184: {
    185:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
    186:   if (!keyval) Keyval_setup();
    187:   *flag                  = attr[comm-1][keyval].active;
    188:   *(void**)attribute_val = attr[comm-1][keyval].attribute_val;
    189:   return MPI_SUCCESS;
    190: }

    192: int MPI_Comm_create(MPI_Comm comm,MPI_Group group,MPI_Comm *newcomm)
    193: {
    194:   int j;
    195:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
    196:   for (j=3; j<MaxComm; j++) {
    197:     if (!comm_active[j-1]) {
    198:       comm_active[j-1] = 1;
    199:       *newcomm = j;
    200:       return MPI_SUCCESS;
    201:     }
    202:   }
    203:   if (MaxComm > MAX_COMM) return MPI_FAILURE;
    204:   *newcomm =  MaxComm++;
    205:   comm_active[*newcomm-1] = 1;
    206:   return MPI_SUCCESS;
    207: }

    209: int MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
    210: {
    211:   int j;
    212:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
    213:   for (j=3; j<MaxComm; j++) {
    214:     if (!comm_active[j-1]) {
    215:       comm_active[j-1] = 1;
    216:       *out = j;
    217:       return MPI_SUCCESS;
    218:     }
    219:   }
    220:   if (MaxComm > MAX_COMM) return MPI_FAILURE;
    221:   *out = MaxComm++;
    222:   comm_active[*out-1] = 1;
    223:   return MPI_SUCCESS;
    224: }

    226: int MPI_Comm_free(MPI_Comm *comm)
    227: {
    228:   int i;

    230:   if (*comm-1 < 0 || *comm-1 > MaxComm) return MPI_FAILURE;
    231:   for (i=0; i<num_attr; i++) {
    232:     if (attr[*comm-1][i].active && attr_keyval[i].del) (*attr_keyval[i].del)(*comm,i,attr[*comm-1][i].attribute_val,attr_keyval[i].extra_state);
    233:     attr[*comm-1][i].active        = 0;
    234:     attr[*comm-1][i].attribute_val = 0;
    235:   }
    236:   if (*comm >= 3) comm_active[*comm-1] = 0;
    237:   *comm = 0;
    238:   return MPI_SUCCESS;
    239: }

    241: int MPI_Comm_size(MPI_Comm comm, int *size)
    242: {
    243:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
    244:   *size=1;
    245:   return MPI_SUCCESS;
    246: }

    248: int MPI_Comm_rank(MPI_Comm comm, int *rank)
    249: {
    250:   if (comm-1 < 0 || comm-1 > MaxComm) return MPI_FAILURE;
    251:   *rank=0;
    252:   return MPI_SUCCESS;
    253: }

    255: int MPIUni_Abort(MPI_Comm comm,int errorcode)
    256: {
    257:   printf("MPI operation not supported by PETSc's sequential MPI wrappers\n");
    258:   return MPI_FAILURE;
    259: }

    261: int MPI_Abort(MPI_Comm comm,int errorcode)
    262: {
    263:   abort();
    264:   return MPI_SUCCESS;
    265: }

    267: /* --------------------------------------------------------------------------*/

    269: static int MPI_was_initialized = 0;
    270: static int MPI_was_finalized   = 0;

    272: int MPI_Init(int *argc, char ***argv)
    273: {
    274:   if (MPI_was_initialized) return MPI_FAILURE;
    275:   if (MPI_was_finalized) return MPI_FAILURE;
    276:   MPI_was_initialized = 1;
    277:   return MPI_SUCCESS;
    278: }

    280: int MPI_Finalize(void)
    281: {
    282:   MPI_Comm comm;
    283:   if (MPI_was_finalized) return MPI_FAILURE;
    284:   if (!MPI_was_initialized) return MPI_FAILURE;
    285:   comm = MPI_COMM_WORLD;
    286:   MPI_Comm_free(&comm);
    287:   comm = MPI_COMM_SELF;
    288:   MPI_Comm_free(&comm);
    289:   MPI_was_finalized = 1;
    290:   return MPI_SUCCESS;
    291: }

    293: int MPI_Initialized(int *flag)
    294: {
    295:   *flag = MPI_was_initialized;
    296:   return MPI_SUCCESS;
    297: }

    299: int MPI_Finalized(int *flag)
    300: {
    301:   *flag = MPI_was_finalized;
    302:   return MPI_SUCCESS;
    303: }

    305: /* -------------------     Fortran versions of several routines ------------------ */

    307: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    308: #define mpiunisetmoduleblock_          MPIUNISETMODULEBLOCK
    309: #define mpiunisetfortranbasepointers_  MPIUNISETFORTRANBASEPOINTERS
    310: #define petsc_mpi_init_                PETSC_MPI_INIT
    311: #define petsc_mpi_finalize_            PETSC_MPI_FINALIZE
    312: #define petsc_mpi_comm_size_           PETSC_MPI_COMM_SIZE
    313: #define petsc_mpi_comm_rank_           PETSC_MPI_COMM_RANK
    314: #define petsc_mpi_abort_               PETSC_MPI_ABORT
    315: #define petsc_mpi_reduce_              PETSC_MPI_REDUCE
    316: #define petsc_mpi_allreduce_           PETSC_MPI_ALLREDUCE
    317: #define petsc_mpi_barrier_             PETSC_MPI_BARRIER
    318: #define petsc_mpi_bcast_               PETSC_MPI_BCAST
    319: #define petsc_mpi_gather_              PETSC_MPI_GATHER
    320: #define petsc_mpi_allgather_           PETSC_MPI_ALLGATHER
    321: #define petsc_mpi_comm_split_          PETSC_MPI_COMM_SPLIT
    322: #define petsc_mpi_scan_                PETSC_MPI_SCAN
    323: #define petsc_mpi_send_                PETSC_MPI_SEND
    324: #define petsc_mpi_recv_                PETSC_MPI_RECV
    325: #define petsc_mpi_reduce_scatter_      PETSC_MPI_REDUCE_SCATTER
    326: #define petsc_mpi_irecv_               PETSC_MPI_IRECV
    327: #define petsc_mpi_isend_               PETSC_MPI_ISEND
    328: #define petsc_mpi_sendrecv_            PETSC_MPI_SENDRECV
    329: #define petsc_mpi_test_                PETSC_MPI_TEST
    330: #define petsc_mpi_waitall_             PETSC_MPI_WAITALL
    331: #define petsc_mpi_waitany_             PETSC_MPI_WAITANY
    332: #define petsc_mpi_allgatherv_          PETSC_MPI_ALLGATHERV
    333: #define petsc_mpi_alltoallv_           PETSC_MPI_ALLTOALLV
    334: #define petsc_mpi_comm_create_         PETSC_MPI_COMM_CREATE
    335: #define petsc_mpi_address_             PETSC_MPI_ADDRESS
    336: #define petsc_mpi_pack_                PETSC_MPI_PACK
    337: #define petsc_mpi_unpack_              PETSC_MPI_UNPACK
    338: #define petsc_mpi_pack_size_           PETSC_MPI_PACK_SIZE
    339: #define petsc_mpi_type_struct_         PETSC_MPI_TYPE_STRUCT
    340: #define petsc_mpi_type_commit_         PETSC_MPI_TYPE_COMMIT
    341: #define petsc_mpi_wtime_               PETSC_MPI_WTIME
    342: #define petsc_mpi_cancel_              PETSC_MPI_CANCEL
    343: #define petsc_mpi_comm_dup_            PETSC_MPI_COMM_DUP
    344: #define petsc_mpi_comm_free_           PETSC_MPI_COMM_FREE
    345: #define petsc_mpi_get_count_           PETSC_MPI_GET_COUNT
    346: #define petsc_mpi_get_processor_name_  PETSC_MPI_GET_PROCESSOR_NAME
    347: #define petsc_mpi_initialized_         PETSC_MPI_INITIALIZED
    348: #define petsc_mpi_iprobe_              PETSC_MPI_IPROBE
    349: #define petsc_mpi_probe_               PETSC_MPI_PROBE
    350: #define petsc_mpi_request_free_        PETSC_MPI_REQUEST_FREE
    351: #define petsc_mpi_ssend_               PETSC_MPI_SSEND
    352: #define petsc_mpi_wait_                PETSC_MPI_WAIT
    353: #define petsc_mpi_comm_group_          PETSC_MPI_COMM_GROUP
    354: #define petsc_mpi_exscan_              PETSC_MPI_EXSCAN
    355: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    356: #define mpiunisetmoduleblock_          mpiunisetmoduleblock
    357: #define mpiunisetfortranbasepointers_  mpiunisetfortranbasepointers
    358: #define petsc_mpi_init_                petsc_mpi_init
    359: #define petsc_mpi_finalize_            petsc_mpi_finalize
    360: #define petsc_mpi_comm_size_           petsc_mpi_comm_size
    361: #define petsc_mpi_comm_rank_           petsc_mpi_comm_rank
    362: #define petsc_mpi_abort_               petsc_mpi_abort
    363: #define petsc_mpi_reduce_              petsc_mpi_reduce
    364: #define petsc_mpi_allreduce_           petsc_mpi_allreduce
    365: #define petsc_mpi_barrier_             petsc_mpi_barrier
    366: #define petsc_mpi_bcast_               petsc_mpi_bcast
    367: #define petsc_mpi_gather_              petsc_mpi_gather
    368: #define petsc_mpi_allgather_           petsc_mpi_allgather
    369: #define petsc_mpi_comm_split_          petsc_mpi_comm_split
    370: #define petsc_mpi_scan_                petsc_mpi_scan
    371: #define petsc_mpi_send_                petsc_mpi_send
    372: #define petsc_mpi_recv_                petsc_mpi_recv
    373: #define petsc_mpi_reduce_scatter_      petsc_mpi_reduce_scatter
    374: #define petsc_mpi_irecv_               petsc_mpi_irecv
    375: #define petsc_mpi_isend_               petsc_mpi_isend
    376: #define petsc_mpi_sendrecv_            petsc_mpi_sendrecv
    377: #define petsc_mpi_test_                petsc_mpi_test
    378: #define petsc_mpi_waitall_             petsc_mpi_waitall
    379: #define petsc_mpi_waitany_             petsc_mpi_waitany
    380: #define petsc_mpi_allgatherv_          petsc_mpi_allgatherv
    381: #define petsc_mpi_alltoallv_           petsc_mpi_alltoallv
    382: #define petsc_mpi_comm_create_         petsc_mpi_comm_create
    383: #define petsc_mpi_address_             petsc_mpi_address
    384: #define petsc_mpi_pack_                petsc_mpi_pack
    385: #define petsc_mpi_unpack_              petsc_mpi_unpack
    386: #define petsc_mpi_pack_size_           petsc_mpi_pack_size
    387: #define petsc_mpi_type_struct_         petsc_mpi_type_struct
    388: #define petsc_mpi_type_commit_         petsc_mpi_type_commit
    389: #define petsc_mpi_wtime_               petsc_mpi_wtime
    390: #define petsc_mpi_cancel_              petsc_mpi_cancel
    391: #define petsc_mpi_comm_dup_            petsc_mpi_comm_dup
    392: #define petsc_mpi_comm_free_           petsc_mpi_comm_free
    393: #define petsc_mpi_get_count_           petsc_mpi_get_count
    394: #define petsc_mpi_get_processor_name_  petsc_mpi_get_processor_name
    395: #define petsc_mpi_initialized_         petsc_mpi_initialized
    396: #define petsc_mpi_iprobe_              petsc_mpi_iprobe
    397: #define petsc_mpi_probe_               petsc_mpi_probe
    398: #define petsc_mpi_request_free_        petsc_mpi_request_free
    399: #define petsc_mpi_ssend_               petsc_mpi_ssend
    400: #define petsc_mpi_wait_                petsc_mpi_wait
    401: #define petsc_mpi_comm_group_          petsc_mpi_comm_group
    402: #define petsc_mpi_exscan_              petsc_mpi_exscan
    403: #endif

    405: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
    406: #define petsc_mpi_init_                petsc_mpi_init__
    407: #define petsc_mpi_finalize_            petsc_mpi_finalize__
    408: #define petsc_mpi_comm_size_           petsc_mpi_comm_size__
    409: #define petsc_mpi_comm_rank_           petsc_mpi_comm_rank__
    410: #define petsc_mpi_abort_               petsc_mpi_abort__
    411: #define petsc_mpi_reduce_              petsc_mpi_reduce__
    412: #define petsc_mpi_allreduce_           petsc_mpi_allreduce__
    413: #define petsc_mpi_barrier_             petsc_mpi_barrier__
    414: #define petsc_mpi_bcast_               petsc_mpi_bcast__
    415: #define petsc_mpi_gather_              petsc_mpi_gather__
    416: #define petsc_mpi_allgather_           petsc_mpi_allgather__
    417: #define petsc_mpi_comm_split_          petsc_mpi_comm_split__
    418: #define petsc_mpi_scan_                petsc_mpi_scan__
    419: #define petsc_mpi_send_                petsc_mpi_send__
    420: #define petsc_mpi_recv_                petsc_mpi_recv__
    421: #define petsc_mpi_reduce_scatter_      petsc_mpi_reduce_scatter__
    422: #define petsc_mpi_irecv_               petsc_mpi_irecv__
    423: #define petsc_mpi_isend_               petsc_mpi_isend__
    424: #define petsc_mpi_sendrecv_            petsc_mpi_sendrecv__
    425: #define petsc_mpi_test_                petsc_mpi_test__
    426: #define petsc_mpi_waitall_             petsc_mpi_waitall__
    427: #define petsc_mpi_waitany_             petsc_mpi_waitany__
    428: #define petsc_mpi_allgatherv_          petsc_mpi_allgatherv__
    429: #define petsc_mpi_alltoallv_           petsc_mpi_alltoallv__
    430: #define petsc_mpi_comm_create_         petsc_mpi_comm_create__
    431: #define petsc_mpi_address_             petsc_mpi_address__
    432: #define petsc_mpi_pack_                petsc_mpi_pack__
    433: #define petsc_mpi_unpack_              petsc_mpi_unpack__
    434: #define petsc_mpi_pack_size_           petsc_mpi_pack_size__
    435: #define petsc_mpi_type_struct_         petsc_mpi_type_struct__
    436: #define petsc_mpi_type_commit_         petsc_mpi_type_commit__
    437: #define petsc_mpi_wtime_               petsc_mpi_wtime__
    438: #define petsc_mpi_cancel_              petsc_mpi_cancel__
    439: #define petsc_mpi_comm_dup_            petsc_mpi_comm_dup__
    440: #define petsc_mpi_comm_free_           petsc_mpi_comm_free__
    441: #define petsc_mpi_get_count_           petsc_mpi_get_count__
    442: #define petsc_mpi_get_processor_name_  petsc_mpi_get_processor_name__
    443: #define petsc_mpi_initialized_         petsc_mpi_initialized__
    444: #define petsc_mpi_iprobe_              petsc_mpi_iprobe__
    445: #define petsc_mpi_probe_               petsc_mpi_probe__
    446: #define petsc_mpi_request_free_        petsc_mpi_request_free__
    447: #define petsc_mpi_ssend_               petsc_mpi_ssend__
    448: #define petsc_mpi_wait_                petsc_mpi_wait__
    449: #define petsc_mpi_comm_group_          petsc_mpi_comm_group__
    450: #define petsc_mpi_exscan_              petsc_mpi_exscan__
    451: #endif

    453: /* Do not build fortran interface if MPI namespace colision is to be avoided */
    454: #if defined(PETSC_HAVE_FORTRAN)

    456: PETSC_EXTERN void PETSC_STDCALL mpiunisetmoduleblock_(void);

    458: PETSC_EXTERN void PETSC_STDCALL mpiunisetfortranbasepointers_(void *f_mpi_in_place)
    459: {
    460:   MPIUNIF_mpi_in_place   = f_mpi_in_place;
    461: }

    463: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_init_(int *ierr)
    464: {
    465:   mpiunisetmoduleblock_();
    466:   *MPI_Init((int*)0, (char***)0);
    467: }

    469: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_finalize_(int *ierr)
    470: {
    471:   *MPI_Finalize();
    472: }

    474: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
    475: {
    476:   *size = 1;
    477:   *0;
    478: }

    480: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
    481: {
    482:   *rank = 0;
    483:   *MPI_SUCCESS;
    484: }

    486: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr)
    487: {
    488:   *newcomm = *comm;
    489:   *MPI_SUCCESS;
    490: }

    492: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
    493: {
    494:   abort();
    495:   *MPI_SUCCESS;
    496: }

    498: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_reduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *root,int *comm,int *ierr)
    499: {
    500:   *MPI_Reduce(sendbuf,recvbuf,*count,*datatype,*op,*root,*comm);
    501: }

    503: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
    504: {
    505:   *MPI_Allreduce(sendbuf,recvbuf,*count,*datatype,*op,*comm);
    506: }

    508: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_barrier_(MPI_Comm *comm,int *ierr)
    509: {
    510:   *MPI_SUCCESS;
    511: }

    513: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr)
    514: {
    515:   *MPI_SUCCESS;
    516: }

    518: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype, int *root,int *comm,int *ierr)
    519: {
    520:   *MPI_Gather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*root,*comm);
    521: }

    523: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype,int *comm,int *ierr)
    524: {
    525:   *MPI_Allgather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*comm);
    526: }

    528: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_scan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
    529: {
    530:   *MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPI_sizeof(*datatype));
    531: }

    533: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_send_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
    534: {
    535:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    536: }

    538: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_recv_(void *buf,int *count,int *datatype,int *source,int *tag,int *comm,int status,int *ierr)
    539: {
    540:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    541: }

    543: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_reduce_scatter_(void *sendbuf,void *recvbuf,int *recvcounts,int *datatype,int *op,int *comm,int *ierr)
    544: {
    545:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    546: }

    548: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_irecv_(void *buf,int *count, int *datatype, int *source, int *tag, int *comm, int *request, int *ierr)
    549: {
    550:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    551: }

    553: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_isend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *request, int *ierr)
    554: {
    555:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    556: }

    558: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_sendrecv_(void *sendbuf,int *sendcount,int *sendtype,int *dest,int *sendtag,void *recvbuf,int *recvcount,int *recvtype,int *source,int *recvtag,int *comm,int *status,int *ierr)
    559: {
    560:   *MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPI_sizeof(*sendtype));
    561: }

    563: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_test_(int *request,int *flag,int *status,int *ierr)
    564: {
    565:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    566: }

    568: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_waitall_(int *count,int *array_of_requests,int *array_of_statuses,int *ierr)
    569: {
    570:   *MPI_SUCCESS;
    571: }

    573: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_waitany_(int *count,int *array_of_requests,int * index, int *status,int *ierr)
    574: {
    575:   *MPI_SUCCESS;
    576: }

    578: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_allgatherv_(void *sendbuf,int *sendcount,int *sendtype,void *recvbuf,int *recvcounts,int *displs,int *recvtype,int *comm,int *ierr)
    579: {
    580:   *MPI_Allgatherv(sendbuf,*sendcount,*sendtype,recvbuf,recvcounts,displs,*recvtype,*comm);
    581: }

    583: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_alltoallv_(void *sendbuf,int *sendcounts,int *sdispls,int *sendtype,void *recvbuf,int *recvcounts,int *rdispls,int *recvtype,int *comm,int *ierr)
    584: {
    585:   *MPI_Alltoallv(sendbuf,sendcounts,sdispls,*sendtype,recvbuf,recvcounts,rdispls,*recvtype,*comm);
    586: }

    588: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_create_(int *comm,int *group,int *newcomm,int *ierr)
    589: {
    590:   *newcomm =  *comm;
    591:   *MPI_SUCCESS;
    592: }

    594: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_address_(void *location,MPI_Aint *address,int *ierr)
    595: {
    596:   *address =  (MPI_Aint) ((char *)location);
    597:   *MPI_SUCCESS;
    598: }

    600: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_pack_(void *inbuf,int *incount,int *datatype,void *outbuf,int *outsize,int *position,int *comm,int *ierr)
    601: {
    602:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    603: }

    605: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_unpack_(void *inbuf,int *insize,int *position,void *outbuf,int *outcount,int *datatype,int *comm,int *ierr)
    606: {
    607:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    608: }

    610: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_pack_size_(int *incount,int *datatype,int *comm,int *size,int *ierr)
    611: {
    612:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    613: }

    615: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_type_struct_(int *count,int *array_of_blocklengths,int * array_of_displaments,int *array_of_types,int *newtype,int *ierr)
    616: {
    617:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    618: }

    620: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_type_commit_(int *datatype,int *ierr)
    621: {
    622:   *MPI_SUCCESS;
    623: }

    625: double PETSC_STDCALL petsc_mpi_wtime_(void)
    626: {
    627:   return 0.0;
    628: }

    630: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_cancel_(int *request,int *ierr)
    631: {
    632:   *MPI_SUCCESS;
    633: }

    635: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_dup_(int *comm,int *out,int *ierr)
    636: {
    637:   *out  = *comm;
    638:   *MPI_SUCCESS;
    639: }

    641: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_free_(int *comm,int *ierr)
    642: {
    643:   *MPI_SUCCESS;
    644: }

    646: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_get_count_(int *status,int *datatype,int *count,int *ierr)
    647: {
    648:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    649: }

    651: /* duplicate from fortranimpl.h */
    652: #ifndef PETSC_FORTRAN_CHARLEN_T
    653: #  define PETSC_FORTRAN_CHARLEN_T int
    654: #endif
    655: #if defined(PETSC_HAVE_FORTRAN_MIXED_STR_ARG)
    656: #define PETSC_MIXED_LEN(len) ,PETSC_FORTRAN_CHARLEN_T len
    657: #define PETSC_END_LEN(len)
    658: #else
    659: #define PETSC_MIXED_LEN(len)
    660: #define PETSC_END_LEN(len)   ,PETSC_FORTRAN_CHARLEN_T len
    661: #endif

    663: 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))
    664: {
    665:   MPIUNI_Memcpy(name,"localhost",9*sizeof(char));
    666:   *result_len = 9;
    667:   *MPI_SUCCESS;
    668: }

    670: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_initialized_(int *flag,int *ierr)
    671: {
    672:   *flag = MPI_was_initialized;
    673:   *MPI_SUCCESS;
    674: }

    676: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_iprobe_(int *source,int *tag,int *comm,int *glag,int *status,int *ierr)
    677: {
    678:   *MPI_SUCCESS;
    679: }

    681: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_probe_(int *source,int *tag,int *comm,int *flag,int *status,int *ierr)
    682: {
    683:   *MPI_SUCCESS;
    684: }

    686: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_request_free_(int *request,int *ierr)
    687: {
    688:   *MPI_SUCCESS;
    689: }

    691: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_ssend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
    692: {
    693:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    694: }

    696: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_wait_(int *request,int *status,int *ierr)
    697: {
    698:   *MPI_SUCCESS;
    699: }

    701: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_comm_group_(int *comm,int *group,int *ierr)
    702: {
    703:   *MPI_SUCCESS;
    704: }

    706: PETSC_EXTERN void PETSC_STDCALL petsc_mpi_exscan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
    707: {
    708:   *MPI_SUCCESS;
    709: }

    711: #endif /* PETSC_HAVE_FORTRAN */

    713: #if defined(__cplusplus)
    714: }
    715: #endif