24 #define MPI_Comm_rank      PMPI_Comm_rank    25 #define MPI_Comm_size      PMPI_Comm_size         26 #define MPI_Gather     PMPI_Gather        27 #define MPI_Scatter    PMPI_Scatter       28 #define MPI_Bcast      PMPI_Bcast         29 #define MPI_Barrier    PMPI_Barrier       30 #define MPI_Comm_split     PMPI_Comm_split        31 #define MPI_Send           PMPI_Send    32 #define MPI_Recv           PMPI_Recv    37 #include <sys/types.h>    44 #include "sion_error_handler.h"    54 int _sion_register_callbacks_mpi() {
    56   aid=sion_generic_create_api(
"SIONlib_MPI_API");
    59   sion_generic_register_create_local_commgroup_cb(aid,&_sion_mpi_create_lcg_cb);
    60   sion_generic_register_free_local_commgroup_cb(aid,&_sion_mpi_free_lcg_cb);
    62   sion_generic_register_barrier_cb(aid,&_sion_mpi_barrier_cb);
    63   sion_generic_register_bcastr_cb(aid,&_sion_mpi_bcastr_cb);
    64   sion_generic_register_gatherr_cb(aid,&_sion_mpi_gatherr_cb);
    65   sion_generic_register_scatterr_cb(aid,&_sion_mpi_scatterr_cb);
    66   sion_generic_register_gathervr_cb(aid,&_sion_mpi_gathervr_cb);
    67   sion_generic_register_scattervr_cb(aid,&_sion_mpi_scattervr_cb);
    68   sion_generic_register_gather_and_execute_cb(aid,&_sion_mpi_gather_process_cb);
    69   sion_generic_register_execute_and_scatter_cb(aid,&_sion_mpi_process_scatter_cb);
    70   sion_generic_register_get_capability_cb(aid,&_sion_mpi_get_capability_cb);
    75 int _sion_mpi_create_lcg_cb(
void **local_commgroup, 
void *global_commgroup, 
    78                 int filenumber, 
int numfiles
    84   int create_lcomm=1, set_in_global=1, mrank=0, msize=1, color;
    86   DPRINTFP((256, 
"_mpi_create_lcg_cb", grank, 
" split now comm: grank=%d gsize=%d filenumber=%d, numfiles=%d, lrank=%d lsize=%d \n", 
    87         grank, gsize, filenumber, numfiles, lrank, lsize));
    89   if(global_commgroup==NULL) {
    90     fprintf(stderr,
"_mpi_create_lcg_cb: error no global commgroup given, aborting  ...\n");
    93   if(*local_commgroup!=NULL) {
    94     fprintf(stderr,
"_mpi_create_lcg_cb: error local commgroup already initialized, aborting  ...\n");
    99   if(sapi_global->lcommgroup!=NULL) {
   101     if(sapi_global->lcommgroup->commset==0) {
   102       *local_commgroup=sapi_global->lcommgroup;
   103       create_lcomm=0;set_in_global=0; 
   104       sapi_global->lcommgroup->commset=1;
   106       create_lcomm=1;set_in_global=0; 
   114     if (commgroup == NULL) {
   115       fprintf(stderr,
"_mpi_create_lcg_cb: cannot allocate memory for local commgroup of size %lu, aborting ...\n",
   120     if(filenumber==-1) color=MPI_UNDEFINED;
   122     rc = MPI_Comm_split(sapi_global->comm, color, lrank, &commgroup->comm);
   123     DPRINTFP((256, 
"_mpi_create_lcg_cb", grank, 
" rc=%d from MPI_Comm_split(comm,%d,%d,&newcomm)\n",rc,color,lrank));
   124     commgroup->local=1;  commgroup->commset=1; commgroup->lcommgroup=NULL;
   125     commgroup->commcreated=1;
   126     commgroup->rank=lrank;
   127     commgroup->size=lsize;
   132     sapi_global->lcommgroup=commgroup; 
   135   *local_commgroup=commgroup;
   137   if((filenumber!=-1) && commgroup) {
   138     MPI_Comm_rank(commgroup->comm, &mrank);
   139     MPI_Comm_size(commgroup->comm, &msize);
   142   DPRINTFP((256, 
"_mpi_create_lcg_cb", grank, 
" leave rc=%d rank %d of %d\n",rc,mrank,msize));
   147 int _sion_mpi_free_lcg_cb(
void *local_commgroup) {
   151   if ( (commgroup->commset) && (commgroup->commcreated) ) {
   152     DPRINTFP((256, 
"_mpi_free_lcg_cb", commgroup->rank, 
" free now comm\n"));
   153     rc=MPI_Comm_free(&commgroup->comm);
   154     DPRINTFP((256, 
"_mpi_free_lcg_cb", commgroup->rank, 
" free now comm rc=%d\n",rc));
   160 int _sion_mpi_barrier_cb(
void *commdata)
   164   MPI_Comm commp = sapi->comm;
   165   rc = MPI_Barrier(commp);
   169 int _sion_mpi_bcastr_cb(
void *data, 
void *commdata, 
int dtype, 
int nelem, 
int root)
   173   MPI_Comm commp = sapi->comm;
   176     rc = MPI_Bcast((sion_int32 *) data, nelem, SION_MPI_INT32, root, commp);
   179     rc = MPI_Bcast((sion_int64 *) data, nelem, SION_MPI_INT64, root, commp);
   182     rc = MPI_Bcast((
char *) data, nelem, MPI_CHAR, root, commp);
   185     rc = MPI_Bcast((sion_int64 *) data, nelem, SION_MPI_INT64, root, commp);
   191 int _sion_mpi_gatherr_cb(
void *indata, 
void *outdata, 
void *commdata, 
int dtype, 
int nelem, 
int root)
   196   MPI_Comm commp = sapi->comm;
   198   MPI_Comm_rank(commp, &rank);
   199   MPI_Comm_size(commp, &size);
   201   DPRINTFP((256, 
"_mpi_gatherr_cb", rank, 
" gatherr on %d of %d nelem=%d root=%d\n", rank, size, nelem, root));
   206     rc = MPI_Gather((sion_int32 *) indata, nelem, SION_MPI_INT32, (sion_int32 *) outdata, nelem, SION_MPI_INT32, root, commp);
   209     rc = MPI_Gather((sion_int64 *) indata, nelem, SION_MPI_INT64, (sion_int64 *) outdata, nelem, SION_MPI_INT64, root, commp);
   212     rc = MPI_Gather((
char *) indata, nelem, MPI_CHAR, (
char *) outdata, nelem, MPI_CHAR, root, commp);
   215     rc = MPI_Gather((sion_int64 *) indata, nelem, SION_MPI_INT64, (sion_int64 *) outdata, nelem, SION_MPI_INT64, root, commp);
   223 int _sion_mpi_scatterr_cb(
void *indata, 
void *outdata, 
void *commdata, 
int dtype, 
int nelem, 
int root)
   227   MPI_Comm commp = sapi->comm;
   228   ONLY_DEBUG(
int rank=sapi->rank);
   230   DPRINTFP((256, 
"_mpi_scatterr_cb", rank, 
" starting nelem=%d root=%d\n", nelem, root));
   234     rc = MPI_Scatter((sion_int32 *) indata, nelem, SION_MPI_INT32, (sion_int32 *) outdata, nelem, SION_MPI_INT32, root, commp);
   237     rc = MPI_Scatter((sion_int64 *) indata, nelem, SION_MPI_INT64, (sion_int64 *) outdata, nelem, SION_MPI_INT64, root, commp);
   240     rc = MPI_Scatter((
char *) indata, nelem, MPI_CHAR, (
char *) outdata, nelem, MPI_CHAR, root, commp);
   243     rc = MPI_Scatter((sion_int64 *) indata, nelem, SION_MPI_INT64, (sion_int64 *) outdata, nelem, SION_MPI_INT64, root, commp);
   250 int _sion_mpi_gathervr_cb(
void *indata, 
void *outdata, 
void *commdata, 
int dtype, 
int *counts, 
int nelem, 
int root)
   253   int       size, rank, t, offset;
   256   MPI_Comm commp = sapi->comm;
   259   MPI_Comm_rank(commp, &rank);
   260   MPI_Comm_size(commp, &size);
   262   DPRINTFP((256, 
"_mpi_gathervr_cb", rank, 
" input nelem=%d root=%d indata=%x, outdata=%x\n", nelem, root, indata, outdata));
   266     displs = (
int *) malloc(size * 
sizeof(
int));
   267     if (displs == NULL) {
   268       fprintf(stderr,
"_mpi_gathervr_cb: cannot allocate temporary memory of size %zu (displs), aborting ...\n",(
size_t) size * 
sizeof(
int));
   272     for(t=0;t<size;t++) {
   282     rc = MPI_Gatherv((sion_int32 *) indata, nelem, SION_MPI_INT32, (sion_int32 *) outdata, counts, displs, SION_MPI_INT32, root, commp);
   285     rc = MPI_Gatherv((sion_int64 *) indata, nelem, SION_MPI_INT64, (sion_int64 *) outdata, counts, displs, SION_MPI_INT64, root, commp);
   288     rc = MPI_Gatherv((
char *) indata, nelem, MPI_CHAR, (sion_int32 *) outdata, counts, displs, MPI_CHAR, root, commp);
   291     rc = MPI_Gatherv((sion_int64 *) indata, nelem, SION_MPI_INT64, (sion_int64 *) outdata, counts, displs, SION_MPI_INT64, root, commp);
   296     if(displs) free(displs);
   301 int _sion_mpi_scattervr_cb(
void *indata, 
void *outdata, 
void *commdata, 
int dtype, 
int *counts, 
int nelem, 
int root)
   304   int       size, rank, t, offset;
   307   MPI_Comm commp = sapi->comm;
   310   MPI_Comm_rank(commp, &rank);
   311   MPI_Comm_size(commp, &size);
   313   DPRINTFP((256, 
"_mpi_scattervr_cb", rank, 
" input nelem=%d root=%d\n", nelem, root));
   317     displs = (
int *) malloc(size * 
sizeof(
int));
   318     if (displs == NULL) {
   319       fprintf(stderr,
"_mpi_scattervr_cb: cannot allocate temporary memory of size %zu (displs), aborting ...\n",(
size_t) size * 
sizeof(
int));
   323     for(t=0;t<size;t++) {
   326       DPRINTFP((256, 
"_mpi_scattervr_cb", rank, 
" after MPI_Gather %2d -> dpls=%2d sendcounts=%d\n", t,displs[t],counts[t]));
   333     rc = MPI_Scatterv((sion_int32 *) outdata, counts, displs, SION_MPI_INT32, (sion_int32 *) indata, nelem, SION_MPI_INT32, root, commp);
   336     rc = MPI_Scatterv((sion_int64 *) outdata, counts, displs, SION_MPI_INT64, (sion_int64 *) indata, nelem, SION_MPI_INT64, root, commp);
   339     rc = MPI_Scatterv((
char *) outdata, counts, displs, MPI_CHAR, (sion_int32 *) indata, nelem, MPI_CHAR, root, commp);
   342     rc = MPI_Scatterv((sion_int64 *) outdata, counts, displs, SION_MPI_INT64, (sion_int64 *) indata, nelem, SION_MPI_INT64, root, commp);
   347     if(displs) free(displs);