Date: 2022-08-02T03:13:14+00:00

Actual source code: mpi.c

      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

     10: #include <petsc/private/petscimpl.h>

     12: #if defined(PETSC_HAVE_CUDA) || defined(PETSC_HAVE_HIP)
     13: #include <petscdevice.h>
     14: #endif

     16: #define MPI_SUCCESS 0
     17: #define MPI_FAILURE 1

     19: void *MPIUNI_TMP = NULL;

     21: /*
     22:        With MPI Uni there are exactly four distinct communicators:
     23:     MPI_COMM_SELF, MPI_COMM_WORLD, and a MPI_Comm_dup() of each of these (duplicates of duplicates return the same communictor)

     25:     MPI_COMM_SELF and MPI_COMM_WORLD are MPI_Comm_free() in MPI_Finalize() but in general with PETSc,
     26:      the other communicators are freed once the last PETSc object is freed (before MPI_Finalize()).

     28: */
     29: #define MAX_ATTR 256
     30: #define MAX_COMM 128

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

     37: typedef struct {
     38:   void                *extra_state;
     39:   MPI_Delete_function *del;
     40:   int                 active;  /* Is this keyval in use by some comm? */
     41: } MPI_Attr_keyval;

     43: static MPI_Attr_keyval attr_keyval[MAX_ATTR];
     44: static MPI_Attr        attr[MAX_COMM][MAX_ATTR];
     45: static int             comm_active[MAX_COMM];  /* Boolean array indicating which comms are in use */
     46: static int             mpi_tag_ub = 100000000;
     47: static int             num_attr = 1; /* Maximal number of keyvals/attributes ever created, including the predefined MPI_TAG_UB attribute. */
     48: static int             MaxComm  = 2; /* Maximal number of communicators ever created, including comm_self(1), comm_world(2), but not comm_null(0) */
     49: static void*           MPIUNIF_mpi_in_place = 0;

     51: #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[][] */

     53: #if defined(__cplusplus)
     54: extern "C" {
     55: #endif

     57: /*
     58:    To avoid problems with prototypes to the system memcpy() it is duplicated here
     59: */
     60: int MPIUNI_Memcpy(void *dst,const void *src,int n)
     61: {
     62:   if (dst == MPI_IN_PLACE || dst == MPIUNIF_mpi_in_place) return MPI_SUCCESS;
     63:   if (src == MPI_IN_PLACE || src == MPIUNIF_mpi_in_place) return MPI_SUCCESS;
     64:   if (!n) return MPI_SUCCESS;

     66:   /* GPU-aware MPIUNI. Use synchronous copy per MPI semantics */
     67: #if defined(PETSC_HAVE_CUDA)
     68:   if (PetscDeviceInitialized(PETSC_DEVICE_CUDA)) {cudaError_t cerr = cudaMemcpy(dst,src,n,cudaMemcpyDefault);if (cerr != cudaSuccess) return MPI_FAILURE;} else
     69: #elif defined(PETSC_HAVE_HIP)
     70:   if (PetscDeviceInitialized(PETSC_DEVICE_HIP))  {hipError_t  cerr = hipMemcpy(dst,src,n,hipMemcpyDefault);  if (cerr != hipSuccess)  return MPI_FAILURE;} else
     71: #endif
     72:   {memcpy(dst,src,n);}
     73:   return MPI_SUCCESS;
     74: }

     76: static int classcnt = 0;
     77: static int codecnt = 0;

     79: int MPI_Add_error_class(int *cl)
     80: {
     81:   *cl = classcnt++;
     82:   return MPI_SUCCESS;
     83: }

     85: int MPI_Add_error_code(int cl,int *co)
     86: {
     87:   if (cl >= classcnt) return MPI_FAILURE;
     88:   *co = codecnt++;
     89:   return MPI_SUCCESS;
     90: }

     92: int MPI_Type_get_envelope(MPI_Datatype datatype,int *num_integers,int *num_addresses,int *num_datatypes,int *combiner)
     93: {
     94:   int comb = datatype >> 28;
     95:   switch (comb) {
     96:   case MPI_COMBINER_NAMED:
     97:     *num_integers = 0;
     98:     *num_addresses = 0;
     99:     *num_datatypes = 0;
    100:     *combiner = comb;
    101:     break;
    102:   case MPI_COMBINER_DUP:
    103:     *num_integers = 0;
    104:     *num_addresses = 0;
    105:     *num_datatypes = 1;
    106:     *combiner = comb;
    107:     break;
    108:   case MPI_COMBINER_CONTIGUOUS:
    109:     *num_integers = 1;
    110:     *num_addresses = 0;
    111:     *num_datatypes = 1;
    112:     *combiner = comb;
    113:     break;
    114:   default:
    115:     return MPIUni_Abort(MPI_COMM_SELF,1);
    116:   }
    117:   return MPI_SUCCESS;
    118: }

    120: 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)
    121: {
    122:   int comb = datatype >> 28;
    123:   switch (comb) {
    124:   case MPI_COMBINER_NAMED:
    125:     return MPIUni_Abort(MPI_COMM_SELF,1);
    126:   case MPI_COMBINER_DUP:
    127:     if (max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1);
    128:     array_of_datatypes[0] = datatype & 0x0fffffff;
    129:     break;
    130:   case MPI_COMBINER_CONTIGUOUS:
    131:     if (max_integers < 1 || max_datatypes < 1) return MPIUni_Abort(MPI_COMM_SELF,1);
    132:     array_of_integers[0] = (datatype >> 8) & 0xfff; /* count */
    133:     array_of_datatypes[0] = (datatype & 0x0ff000ff) | 0x100;  /* basic named type (count=1) from which the contiguous type is derived */
    134:     break;
    135:   default:
    136:     return MPIUni_Abort(MPI_COMM_SELF,1);
    137:   }
    138:   return MPI_SUCCESS;
    139: }

    141: /*
    142:    Used to set the built-in MPI_TAG_UB attribute
    143: */
    144: static int Keyval_setup(void)
    145: {
    146:   attr[CommIdx(MPI_COMM_WORLD)][0].active        = 1;
    147:   attr[CommIdx(MPI_COMM_WORLD)][0].attribute_val = &mpi_tag_ub;
    148:   attr[CommIdx(MPI_COMM_SELF)][0].active        = 1;
    149:   attr[CommIdx(MPI_COMM_SELF)][0].attribute_val = &mpi_tag_ub;
    150:   attr_keyval[0].active                          = 1;
    151:   return MPI_SUCCESS;
    152: }

    154: int MPI_Comm_create_keyval(MPI_Copy_function *copy_fn,MPI_Delete_function *delete_fn,int *keyval,void *extra_state)
    155: {
    156:   int i,keyid;
    157:   for (i=1; i<num_attr; i++) { /* the first attribute is always in use */
    158:     if (!attr_keyval[i].active) {
    159:       keyid = i;
    160:       goto found;
    161:     }
    162:   }
    163:   if (num_attr >= MAX_ATTR) return MPIUni_Abort(MPI_COMM_WORLD,1);
    164:   keyid = num_attr++;

    166: found:
    167:   attr_keyval[keyid].extra_state = extra_state;
    168:   attr_keyval[keyid].del         = delete_fn;
    169:   attr_keyval[keyid].active      = 1;
    170:   *keyval                        = keyid;
    171:   return MPI_SUCCESS;
    172: }

    174: int MPI_Comm_free_keyval(int *keyval)
    175: {
    176:   attr_keyval[*keyval].extra_state = 0;
    177:   attr_keyval[*keyval].del         = 0;
    178:   attr_keyval[*keyval].active      = 0;
    179:   *keyval = 0;
    180:   return MPI_SUCCESS;
    181: }

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

    192: int MPI_Comm_delete_attr(MPI_Comm comm,int keyval)
    193: {
    194:   int idx = CommIdx(comm);
    195:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    196:   if (attr[idx][keyval].active && attr_keyval[keyval].del) {
    197:     void *save_attribute_val        = attr[idx][keyval].attribute_val;
    198:     attr[idx][keyval].active        = 0;
    199:     attr[idx][keyval].attribute_val = 0;
    200:     (*(attr_keyval[keyval].del))(comm,keyval,save_attribute_val,attr_keyval[keyval].extra_state);
    201:   }
    202:   return MPI_SUCCESS;
    203: }

    205: int MPI_Comm_get_attr(MPI_Comm comm,int keyval,void *attribute_val,int *flag)
    206: {
    207:   int idx = CommIdx(comm);
    208:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    209:   if (!keyval) Keyval_setup();
    210:   *flag                  = attr[idx][keyval].active;
    211:   *(void**)attribute_val = attr[idx][keyval].attribute_val;
    212:   return MPI_SUCCESS;
    213: }

    215: static char all_comm_names[MAX_COMM][MPI_MAX_OBJECT_NAME] = {
    216:   "MPI_COMM_SELF",
    217:   "MPI_COMM_WORLD"
    218: };

    220: int MPI_Comm_get_name(MPI_Comm comm,char *comm_name,int *resultlen)
    221: {
    222:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    223:   if (!comm_name || !resultlen) return MPI_FAILURE;
    224:   strncpy(comm_name,all_comm_names[CommIdx(comm)],MPI_MAX_OBJECT_NAME-1);
    225:   *resultlen = (int)strlen(comm_name);
    226:   return MPI_SUCCESS;
    227: }

    229: int MPI_Comm_set_name(MPI_Comm comm,const char *comm_name)
    230: {
    231:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    232:   if (!comm_name) return MPI_FAILURE;
    233:   if (strlen(comm_name) > MPI_MAX_OBJECT_NAME-1) return MPI_FAILURE;
    234:   strncpy(all_comm_names[CommIdx(comm)],comm_name,MPI_MAX_OBJECT_NAME-1);
    235:   return MPI_SUCCESS;
    236: }

    238: int MPI_Comm_create(MPI_Comm comm,MPI_Group group,MPI_Comm *newcomm)
    239: {
    240:   int j;
    241:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    242:   for (j=3; j<=MaxComm; j++) {
    243:     if (!comm_active[CommIdx(j)]) {
    244:       comm_active[CommIdx(j)] = 1;
    245:       *newcomm = j;
    246:       return MPI_SUCCESS;
    247:     }
    248:   }
    249:   if (MaxComm >= MAX_COMM) return MPI_FAILURE;
    250:   *newcomm = ++MaxComm;
    251:   comm_active[CommIdx(*newcomm)] = 1;
    252:   return MPI_SUCCESS;
    253: }

    255: int MPI_Comm_dup(MPI_Comm comm,MPI_Comm *out)
    256: {
    257:   int j;
    258:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    259:   for (j=3; j<=MaxComm; j++) {
    260:     if (!comm_active[CommIdx(j)]) {
    261:       comm_active[CommIdx(j)] = 1;
    262:       *out = j;
    263:       return MPI_SUCCESS;
    264:     }
    265:   }
    266:   if (MaxComm >= MAX_COMM) return MPI_FAILURE;
    267:   *out = ++MaxComm;
    268:   comm_active[CommIdx(*out)] = 1;
    269:   return MPI_SUCCESS;
    270: }

    272: int MPI_Comm_free(MPI_Comm *comm)
    273: {
    274:   int i;
    275:   int idx = CommIdx(*comm);

    277:   if (*comm < 1 || *comm > MaxComm) return MPI_FAILURE;
    278:   for (i=0; i<num_attr; i++) {
    279:     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);
    280:     attr[idx][i].active        = 0;
    281:     attr[idx][i].attribute_val = 0;
    282:   }
    283:   if (*comm >= 3) comm_active[idx] = 0;
    284:   *comm = 0;
    285:   return MPI_SUCCESS;
    286: }

    288: int MPI_Comm_size(MPI_Comm comm, int *size)
    289: {
    290:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    291:   *size=1;
    292:   return MPI_SUCCESS;
    293: }

    295: int MPI_Comm_rank(MPI_Comm comm, int *rank)
    296: {
    297:   if (comm < 1 || comm > MaxComm) return MPI_FAILURE;
    298:   *rank=0;
    299:   return MPI_SUCCESS;
    300: }

    302: int MPIUni_Abort(MPI_Comm comm,int errorcode)
    303: {
    304:   printf("MPI operation not supported by PETSc's sequential MPI wrappers\n");
    305:   return MPI_ERR_NOSUPPORT;
    306: }

    308: int MPI_Abort(MPI_Comm comm,int errorcode)
    309: {
    310:   abort();
    311:   return MPI_SUCCESS;
    312: }

    314: /* --------------------------------------------------------------------------*/

    316: static int MPI_was_initialized = 0;
    317: static int MPI_was_finalized   = 0;

    319: int MPI_Init(int *argc, char ***argv)
    320: {
    321:   if (MPI_was_initialized) return MPI_FAILURE;
    322:   /* MPI standard says "once MPI_Finalize returns, no MPI routine (not even MPI_Init) may be called", so an MPI standard compliant
    323:      MPIU should have this 'if (MPI_was_finalized) return MPI_FAILURE;' check. We relax it here to make life easier for users
    324:      of MPIU so that they can do multiple PetscInitialize/Finalize().
    325:   */
    326:   /* if (MPI_was_finalized) return MPI_FAILURE; */
    327:   MPI_was_initialized = 1;
    328:   MPI_was_finalized   = 0;
    329:   return MPI_SUCCESS;
    330: }

    332: int MPI_Init_thread(int *argc, char ***argv, int required, int* provided)
    333: {
    334:   MPI_Query_thread(provided);
    335:   return MPI_Init(argc,argv);
    336: }

    338: int MPI_Query_thread(int* provided)
    339: {
    340:   *provided = MPI_THREAD_FUNNELED;
    341:   return MPI_SUCCESS;
    342: }

    344: int MPI_Finalize(void)
    345: {
    346:   MPI_Comm comm;
    347:   if (MPI_was_finalized) return MPI_FAILURE;
    348:   if (!MPI_was_initialized) return MPI_FAILURE;
    349:   comm = MPI_COMM_WORLD;
    350:   MPI_Comm_free(&comm);
    351:   comm = MPI_COMM_SELF;
    352:   MPI_Comm_free(&comm);
    353: #if defined(PETSC_USE_DEBUG)
    354:   {
    355:     int i;
    356:     for (i=3; i<=MaxComm; i++) {
    357:       if (comm_active[CommIdx(i)]) printf("MPIUni warning: MPI communicator %d is not freed before MPI_Finalize()\n", i);
    358:     }
    359:   }
    360: #endif
    361:   /* reset counters */
    362:   MaxComm  = 2;
    363:   num_attr = 1;
    364:   MPI_was_finalized   = 1;
    365:   MPI_was_initialized = 0;
    366:   PETSC_COMM_WORLD    = MPI_COMM_NULL;
    367:   return MPI_SUCCESS;
    368: }

    370: int MPI_Initialized(int *flag)
    371: {
    372:   *flag = MPI_was_initialized;
    373:   return MPI_SUCCESS;
    374: }

    376: int MPI_Finalized(int *flag)
    377: {
    378:   *flag = MPI_was_finalized;
    379:   return MPI_SUCCESS;
    380: }

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

    384: #if defined(PETSC_HAVE_FORTRAN_CAPS)
    385: #define mpiunisetmoduleblock_          MPIUNISETMODULEBLOCK
    386: #define mpiunisetfortranbasepointers_  MPIUNISETFORTRANBASEPOINTERS
    387: #define petsc_mpi_init_                PETSC_MPI_INIT
    388: #define petsc_mpi_finalize_            PETSC_MPI_FINALIZE
    389: #define petsc_mpi_comm_size_           PETSC_MPI_COMM_SIZE
    390: #define petsc_mpi_comm_rank_           PETSC_MPI_COMM_RANK
    391: #define petsc_mpi_abort_               PETSC_MPI_ABORT
    392: #define petsc_mpi_reduce_              PETSC_MPI_REDUCE
    393: #define petsc_mpi_allreduce_           PETSC_MPI_ALLREDUCE
    394: #define petsc_mpi_barrier_             PETSC_MPI_BARRIER
    395: #define petsc_mpi_bcast_               PETSC_MPI_BCAST
    396: #define petsc_mpi_gather_              PETSC_MPI_GATHER
    397: #define petsc_mpi_allgather_           PETSC_MPI_ALLGATHER
    398: #define petsc_mpi_comm_split_          PETSC_MPI_COMM_SPLIT
    399: #define petsc_mpi_scan_                PETSC_MPI_SCAN
    400: #define petsc_mpi_send_                PETSC_MPI_SEND
    401: #define petsc_mpi_recv_                PETSC_MPI_RECV
    402: #define petsc_mpi_reduce_scatter_      PETSC_MPI_REDUCE_SCATTER
    403: #define petsc_mpi_irecv_               PETSC_MPI_IRECV
    404: #define petsc_mpi_isend_               PETSC_MPI_ISEND
    405: #define petsc_mpi_sendrecv_            PETSC_MPI_SENDRECV
    406: #define petsc_mpi_test_                PETSC_MPI_TEST
    407: #define petsc_mpi_waitall_             PETSC_MPI_WAITALL
    408: #define petsc_mpi_waitany_             PETSC_MPI_WAITANY
    409: #define petsc_mpi_allgatherv_          PETSC_MPI_ALLGATHERV
    410: #define petsc_mpi_alltoallv_           PETSC_MPI_ALLTOALLV
    411: #define petsc_mpi_comm_create_         PETSC_MPI_COMM_CREATE
    412: #define petsc_mpi_address_             PETSC_MPI_ADDRESS
    413: #define petsc_mpi_pack_                PETSC_MPI_PACK
    414: #define petsc_mpi_unpack_              PETSC_MPI_UNPACK
    415: #define petsc_mpi_pack_size_           PETSC_MPI_PACK_SIZE
    416: #define petsc_mpi_type_struct_         PETSC_MPI_TYPE_STRUCT
    417: #define petsc_mpi_type_commit_         PETSC_MPI_TYPE_COMMIT
    418: #define petsc_mpi_wtime_               PETSC_MPI_WTIME
    419: #define petsc_mpi_cancel_              PETSC_MPI_CANCEL
    420: #define petsc_mpi_comm_dup_            PETSC_MPI_COMM_DUP
    421: #define petsc_mpi_comm_free_           PETSC_MPI_COMM_FREE
    422: #define petsc_mpi_get_count_           PETSC_MPI_GET_COUNT
    423: #define petsc_mpi_get_processor_name_  PETSC_MPI_GET_PROCESSOR_NAME
    424: #define petsc_mpi_initialized_         PETSC_MPI_INITIALIZED
    425: #define petsc_mpi_iprobe_              PETSC_MPI_IPROBE
    426: #define petsc_mpi_probe_               PETSC_MPI_PROBE
    427: #define petsc_mpi_request_free_        PETSC_MPI_REQUEST_FREE
    428: #define petsc_mpi_ssend_               PETSC_MPI_SSEND
    429: #define petsc_mpi_wait_                PETSC_MPI_WAIT
    430: #define petsc_mpi_comm_group_          PETSC_MPI_COMM_GROUP
    431: #define petsc_mpi_exscan_              PETSC_MPI_EXSCAN
    432: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
    433: #define mpiunisetmoduleblock_          mpiunisetmoduleblock
    434: #define mpiunisetfortranbasepointers_  mpiunisetfortranbasepointers
    435: #define petsc_mpi_init_                petsc_mpi_init
    436: #define petsc_mpi_finalize_            petsc_mpi_finalize
    437: #define petsc_mpi_comm_size_           petsc_mpi_comm_size
    438: #define petsc_mpi_comm_rank_           petsc_mpi_comm_rank
    439: #define petsc_mpi_abort_               petsc_mpi_abort
    440: #define petsc_mpi_reduce_              petsc_mpi_reduce
    441: #define petsc_mpi_allreduce_           petsc_mpi_allreduce
    442: #define petsc_mpi_barrier_             petsc_mpi_barrier
    443: #define petsc_mpi_bcast_               petsc_mpi_bcast
    444: #define petsc_mpi_gather_              petsc_mpi_gather
    445: #define petsc_mpi_allgather_           petsc_mpi_allgather
    446: #define petsc_mpi_comm_split_          petsc_mpi_comm_split
    447: #define petsc_mpi_scan_                petsc_mpi_scan
    448: #define petsc_mpi_send_                petsc_mpi_send
    449: #define petsc_mpi_recv_                petsc_mpi_recv
    450: #define petsc_mpi_reduce_scatter_      petsc_mpi_reduce_scatter
    451: #define petsc_mpi_irecv_               petsc_mpi_irecv
    452: #define petsc_mpi_isend_               petsc_mpi_isend
    453: #define petsc_mpi_sendrecv_            petsc_mpi_sendrecv
    454: #define petsc_mpi_test_                petsc_mpi_test
    455: #define petsc_mpi_waitall_             petsc_mpi_waitall
    456: #define petsc_mpi_waitany_             petsc_mpi_waitany
    457: #define petsc_mpi_allgatherv_          petsc_mpi_allgatherv
    458: #define petsc_mpi_alltoallv_           petsc_mpi_alltoallv
    459: #define petsc_mpi_comm_create_         petsc_mpi_comm_create
    460: #define petsc_mpi_address_             petsc_mpi_address
    461: #define petsc_mpi_pack_                petsc_mpi_pack
    462: #define petsc_mpi_unpack_              petsc_mpi_unpack
    463: #define petsc_mpi_pack_size_           petsc_mpi_pack_size
    464: #define petsc_mpi_type_struct_         petsc_mpi_type_struct
    465: #define petsc_mpi_type_commit_         petsc_mpi_type_commit
    466: #define petsc_mpi_wtime_               petsc_mpi_wtime
    467: #define petsc_mpi_cancel_              petsc_mpi_cancel
    468: #define petsc_mpi_comm_dup_            petsc_mpi_comm_dup
    469: #define petsc_mpi_comm_free_           petsc_mpi_comm_free
    470: #define petsc_mpi_get_count_           petsc_mpi_get_count
    471: #define petsc_mpi_get_processor_name_  petsc_mpi_get_processor_name
    472: #define petsc_mpi_initialized_         petsc_mpi_initialized
    473: #define petsc_mpi_iprobe_              petsc_mpi_iprobe
    474: #define petsc_mpi_probe_               petsc_mpi_probe
    475: #define petsc_mpi_request_free_        petsc_mpi_request_free
    476: #define petsc_mpi_ssend_               petsc_mpi_ssend
    477: #define petsc_mpi_wait_                petsc_mpi_wait
    478: #define petsc_mpi_comm_group_          petsc_mpi_comm_group
    479: #define petsc_mpi_exscan_              petsc_mpi_exscan
    480: #endif

    482: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
    483: #define petsc_mpi_init_                petsc_mpi_init__
    484: #define petsc_mpi_finalize_            petsc_mpi_finalize__
    485: #define petsc_mpi_comm_size_           petsc_mpi_comm_size__
    486: #define petsc_mpi_comm_rank_           petsc_mpi_comm_rank__
    487: #define petsc_mpi_abort_               petsc_mpi_abort__
    488: #define petsc_mpi_reduce_              petsc_mpi_reduce__
    489: #define petsc_mpi_allreduce_           petsc_mpi_allreduce__
    490: #define petsc_mpi_barrier_             petsc_mpi_barrier__
    491: #define petsc_mpi_bcast_               petsc_mpi_bcast__
    492: #define petsc_mpi_gather_              petsc_mpi_gather__
    493: #define petsc_mpi_allgather_           petsc_mpi_allgather__
    494: #define petsc_mpi_comm_split_          petsc_mpi_comm_split__
    495: #define petsc_mpi_scan_                petsc_mpi_scan__
    496: #define petsc_mpi_send_                petsc_mpi_send__
    497: #define petsc_mpi_recv_                petsc_mpi_recv__
    498: #define petsc_mpi_reduce_scatter_      petsc_mpi_reduce_scatter__
    499: #define petsc_mpi_irecv_               petsc_mpi_irecv__
    500: #define petsc_mpi_isend_               petsc_mpi_isend__
    501: #define petsc_mpi_sendrecv_            petsc_mpi_sendrecv__
    502: #define petsc_mpi_test_                petsc_mpi_test__
    503: #define petsc_mpi_waitall_             petsc_mpi_waitall__
    504: #define petsc_mpi_waitany_             petsc_mpi_waitany__
    505: #define petsc_mpi_allgatherv_          petsc_mpi_allgatherv__
    506: #define petsc_mpi_alltoallv_           petsc_mpi_alltoallv__
    507: #define petsc_mpi_comm_create_         petsc_mpi_comm_create__
    508: #define petsc_mpi_address_             petsc_mpi_address__
    509: #define petsc_mpi_pack_                petsc_mpi_pack__
    510: #define petsc_mpi_unpack_              petsc_mpi_unpack__
    511: #define petsc_mpi_pack_size_           petsc_mpi_pack_size__
    512: #define petsc_mpi_type_struct_         petsc_mpi_type_struct__
    513: #define petsc_mpi_type_commit_         petsc_mpi_type_commit__
    514: #define petsc_mpi_wtime_               petsc_mpi_wtime__
    515: #define petsc_mpi_cancel_              petsc_mpi_cancel__
    516: #define petsc_mpi_comm_dup_            petsc_mpi_comm_dup__
    517: #define petsc_mpi_comm_free_           petsc_mpi_comm_free__
    518: #define petsc_mpi_get_count_           petsc_mpi_get_count__
    519: #define petsc_mpi_get_processor_name_  petsc_mpi_get_processor_name__
    520: #define petsc_mpi_initialized_         petsc_mpi_initialized__
    521: #define petsc_mpi_iprobe_              petsc_mpi_iprobe__
    522: #define petsc_mpi_probe_               petsc_mpi_probe__
    523: #define petsc_mpi_request_free_        petsc_mpi_request_free__
    524: #define petsc_mpi_ssend_               petsc_mpi_ssend__
    525: #define petsc_mpi_wait_                petsc_mpi_wait__
    526: #define petsc_mpi_comm_group_          petsc_mpi_comm_group__
    527: #define petsc_mpi_exscan_              petsc_mpi_exscan__
    528: #endif

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

    533: PETSC_EXTERN void mpiunisetmoduleblock_(void);

    535: PETSC_EXTERN void mpiunisetfortranbasepointers_(void *f_mpi_in_place)
    536: {
    537:   MPIUNIF_mpi_in_place   = f_mpi_in_place;
    538: }

    540: PETSC_EXTERN void petsc_mpi_init_(int *ierr)
    541: {
    542:   mpiunisetmoduleblock_();
    543:   *MPI_Init((int*)0, (char***)0);
    544: }

    546: PETSC_EXTERN void petsc_mpi_finalize_(int *ierr)
    547: {
    548:   *MPI_Finalize();
    549: }

    551: PETSC_EXTERN void petsc_mpi_comm_size_(MPI_Comm *comm,int *size,int *ierr)
    552: {
    553:   *size = 1;
    554:   *0;
    555: }

    557: PETSC_EXTERN void petsc_mpi_comm_rank_(MPI_Comm *comm,int *rank,int *ierr)
    558: {
    559:   *rank = 0;
    560:   *MPI_SUCCESS;
    561: }

    563: PETSC_EXTERN void petsc_mpi_comm_split_(MPI_Comm *comm,int *color,int *key, MPI_Comm *newcomm, int *ierr)
    564: {
    565:   *newcomm = *comm;
    566:   *MPI_SUCCESS;
    567: }

    569: PETSC_EXTERN void petsc_mpi_abort_(MPI_Comm *comm,int *errorcode,int *ierr)
    570: {
    571:   abort();
    572:   *MPI_SUCCESS;
    573: }

    575: PETSC_EXTERN void petsc_mpi_reduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *root,int *comm,int *ierr)
    576: {
    577:   *MPI_Reduce(sendbuf,recvbuf,*count,*datatype,*op,*root,*comm);
    578: }

    580: PETSC_EXTERN void petsc_mpi_allreduce_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
    581: {
    582:   *MPI_Allreduce(sendbuf,recvbuf,*count,*datatype,*op,*comm);
    583: }

    585: PETSC_EXTERN void petsc_mpi_barrier_(MPI_Comm *comm,int *ierr)
    586: {
    587:   *MPI_SUCCESS;
    588: }

    590: PETSC_EXTERN void petsc_mpi_bcast_(void *buf,int *count,int *datatype,int *root,int *comm,int *ierr)
    591: {
    592:   *MPI_SUCCESS;
    593: }

    595: PETSC_EXTERN void petsc_mpi_gather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype, int *root,int *comm,int *ierr)
    596: {
    597:   *MPI_Gather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*root,*comm);
    598: }

    600: PETSC_EXTERN void petsc_mpi_allgather_(void *sendbuf,int *scount,int *sdatatype, void *recvbuf, int *rcount, int *rdatatype,int *comm,int *ierr)
    601: {
    602:   *MPI_Allgather(sendbuf,*scount,*sdatatype,recvbuf,rcount,rdatatype,*comm);
    603: }

    605: PETSC_EXTERN void petsc_mpi_scan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
    606: {
    607:   *MPIUNI_Memcpy(recvbuf,sendbuf,(*count)*MPI_sizeof(*datatype));
    608: }

    610: PETSC_EXTERN void petsc_mpi_send_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
    611: {
    612:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    613: }

    615: PETSC_EXTERN void petsc_mpi_recv_(void *buf,int *count,int *datatype,int *source,int *tag,int *comm,int status,int *ierr)
    616: {
    617:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    618: }

    620: PETSC_EXTERN void petsc_mpi_reduce_scatter_(void *sendbuf,void *recvbuf,int *recvcounts,int *datatype,int *op,int *comm,int *ierr)
    621: {
    622:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    623: }

    625: PETSC_EXTERN void petsc_mpi_irecv_(void *buf,int *count, int *datatype, int *source, int *tag, int *comm, int *request, int *ierr)
    626: {
    627:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    628: }

    630: PETSC_EXTERN void petsc_mpi_isend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *request, int *ierr)
    631: {
    632:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    633: }

    635: 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)
    636: {
    637:   *MPIUNI_Memcpy(recvbuf,sendbuf,(*sendcount)*MPI_sizeof(*sendtype));
    638: }

    640: PETSC_EXTERN void petsc_mpi_test_(int *request,int *flag,int *status,int *ierr)
    641: {
    642:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    643: }

    645: PETSC_EXTERN void petsc_mpi_waitall_(int *count,int *array_of_requests,int *array_of_statuses,int *ierr)
    646: {
    647:   *MPI_SUCCESS;
    648: }

    650: PETSC_EXTERN void petsc_mpi_waitany_(int *count,int *array_of_requests,int * index, int *status,int *ierr)
    651: {
    652:   *MPI_SUCCESS;
    653: }

    655: PETSC_EXTERN void petsc_mpi_allgatherv_(void *sendbuf,int *sendcount,int *sendtype,void *recvbuf,int *recvcounts,int *displs,int *recvtype,int *comm,int *ierr)
    656: {
    657:   *MPI_Allgatherv(sendbuf,*sendcount,*sendtype,recvbuf,recvcounts,displs,*recvtype,*comm);
    658: }

    660: 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)
    661: {
    662:   *MPI_Alltoallv(sendbuf,sendcounts,sdispls,*sendtype,recvbuf,recvcounts,rdispls,*recvtype,*comm);
    663: }

    665: PETSC_EXTERN void petsc_mpi_comm_create_(int *comm,int *group,int *newcomm,int *ierr)
    666: {
    667:   *newcomm =  *comm;
    668:   *MPI_SUCCESS;
    669: }

    671: PETSC_EXTERN void petsc_mpi_address_(void *location,MPI_Aint *address,int *ierr)
    672: {
    673:   *address =  (MPI_Aint) ((char *)location);
    674:   *MPI_SUCCESS;
    675: }

    677: PETSC_EXTERN void petsc_mpi_pack_(void *inbuf,int *incount,int *datatype,void *outbuf,int *outsize,int *position,int *comm,int *ierr)
    678: {
    679:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    680: }

    682: PETSC_EXTERN void petsc_mpi_unpack_(void *inbuf,int *insize,int *position,void *outbuf,int *outcount,int *datatype,int *comm,int *ierr)
    683: {
    684:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    685: }

    687: PETSC_EXTERN void petsc_mpi_pack_size_(int *incount,int *datatype,int *comm,int *size,int *ierr)
    688: {
    689:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    690: }

    692: 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)
    693: {
    694:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    695: }

    697: PETSC_EXTERN void petsc_mpi_type_commit_(int *datatype,int *ierr)
    698: {
    699:   *MPI_SUCCESS;
    700: }

    702: double petsc_mpi_wtime_(void)
    703: {
    704:   return 0.0;
    705: }

    707: PETSC_EXTERN void petsc_mpi_cancel_(int *request,int *ierr)
    708: {
    709:   *MPI_SUCCESS;
    710: }

    712: PETSC_EXTERN void petsc_mpi_comm_dup_(int *comm,int *out,int *ierr)
    713: {
    714:   *out  = *comm;
    715:   *MPI_SUCCESS;
    716: }

    718: PETSC_EXTERN void petsc_mpi_comm_free_(int *comm,int *ierr)
    719: {
    720:   *MPI_SUCCESS;
    721: }

    723: PETSC_EXTERN void petsc_mpi_get_count_(int *status,int *datatype,int *count,int *ierr)
    724: {
    725:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    726: }

    728: PETSC_EXTERN void petsc_mpi_get_processor_name_(char *name,int *result_len,int *ierr,PETSC_FORTRAN_CHARLEN_T len)
    729: {
    730:   MPIUNI_Memcpy(name,"localhost",9*sizeof(char));
    731:   *result_len = 9;
    732:   *MPI_SUCCESS;
    733: }

    735: PETSC_EXTERN void petsc_mpi_initialized_(int *flag,int *ierr)
    736: {
    737:   *flag = MPI_was_initialized;
    738:   *MPI_SUCCESS;
    739: }

    741: PETSC_EXTERN void petsc_mpi_iprobe_(int *source,int *tag,int *comm,int *glag,int *status,int *ierr)
    742: {
    743:   *MPI_SUCCESS;
    744: }

    746: PETSC_EXTERN void petsc_mpi_probe_(int *source,int *tag,int *comm,int *flag,int *status,int *ierr)
    747: {
    748:   *MPI_SUCCESS;
    749: }

    751: PETSC_EXTERN void petsc_mpi_request_free_(int *request,int *ierr)
    752: {
    753:   *MPI_SUCCESS;
    754: }

    756: PETSC_EXTERN void petsc_mpi_ssend_(void *buf,int *count,int *datatype,int *dest,int *tag,int *comm,int *ierr)
    757: {
    758:   *MPIUni_Abort(MPI_COMM_WORLD,0);
    759: }

    761: PETSC_EXTERN void petsc_mpi_wait_(int *request,int *status,int *ierr)
    762: {
    763:   *MPI_SUCCESS;
    764: }

    766: PETSC_EXTERN void petsc_mpi_comm_group_(int *comm,int *group,int *ierr)
    767: {
    768:   *MPI_SUCCESS;
    769: }

    771: PETSC_EXTERN void petsc_mpi_exscan_(void *sendbuf,void *recvbuf,int *count,int *datatype,int *op,int *comm,int *ierr)
    772: {
    773:   *MPI_SUCCESS;
    774: }

    776: #endif /* PETSC_HAVE_FORTRAN */

    778: #if defined(__cplusplus)
    779: }
    780: #endif