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);