X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/f9df6a0ce7023e4e22d83bb6c50f27bd21fab329..36fa571a13985879dc627c70ecc2340af606aa42:/src/smpi/smpi_f77.cpp diff --git a/src/smpi/smpi_f77.cpp b/src/smpi/smpi_f77.cpp index 248334e80c..3cbb27158a 100644 --- a/src/smpi/smpi_f77.cpp +++ b/src/smpi/smpi_f77.cpp @@ -10,13 +10,22 @@ #include "private.h" #include "xbt.h" +//TODO : remove all this. static xbt_dict_t comm_lookup = nullptr; static xbt_dict_t group_lookup = nullptr; static xbt_dict_t request_lookup = nullptr; -static xbt_dict_t datatype_lookup = nullptr; +static xbt_dict_t type_lookup = nullptr; static xbt_dict_t op_lookup = nullptr; static xbt_dict_t win_lookup = nullptr; static xbt_dict_t info_lookup = nullptr; +static int comm_id=0; +static int group_id=0; +static int request_id=0; +static int type_id=0; +static int op_id=0; +static int win_id=0; +static int info_id=0; + static int running_processes = 0; @@ -28,22 +37,12 @@ typedef long int integer; typedef unsigned long int uinteger; #endif -/* Bindings for MPI special values */ - struct s_smpi_common { - integer _MPI_IN_PLACE; - integer _MPI_BOTTOM; - integer _MPI_STATUS_IGNORE; - integer _MPI_STATUSES_IGNORE; - } smpi_; - /* Convert between Fortran and C */ -#define FORT_ADDR(addr, val) \ - (((void *)(addr) == (void*) &(smpi_._ ## val)) \ - ? (val) : (void *)(addr)) -#define FORT_BOTTOM(addr) FORT_ADDR(addr, MPI_BOTTOM) -#define FORT_IN_PLACE(addr) FORT_ADDR(addr, MPI_IN_PLACE) -#define FORT_STATUS_IGNORE(addr) static_cast(FORT_ADDR(addr, MPI_STATUS_IGNORE)) -#define FORT_STATUSES_IGNORE(addr) static_cast(FORT_ADDR(addr, MPI_STATUSES_IGNORE)) + +#define FORT_BOTTOM(addr) ((*(int*)addr) == -200 ? MPI_BOTTOM : (void*)addr) +#define FORT_IN_PLACE(addr) ((*(int*)addr) == -100 ? MPI_IN_PLACE : (void*)addr) +#define FORT_STATUS_IGNORE(addr) (static_cast((*(int*)addr) == -300 ? MPI_STATUS_IGNORE : (void*)addr)) +#define FORT_STATUSES_IGNORE(addr) (static_cast((*(int*)addr) == -400 ? MPI_STATUSES_IGNORE : (void*)addr)) #define KEY_SIZE (sizeof(int) * 2 + 1) @@ -60,216 +59,175 @@ static char* get_key_id(char* key, int id) { static void smpi_init_fortran_types(){ if(comm_lookup == nullptr){ comm_lookup = xbt_dict_new_homogeneous(nullptr); - smpi_comm_c2f(MPI_COMM_WORLD); + smpi_comm_add_f(MPI_COMM_WORLD); group_lookup = xbt_dict_new_homogeneous(nullptr); request_lookup = xbt_dict_new_homogeneous(nullptr); - datatype_lookup = xbt_dict_new_homogeneous(nullptr); + type_lookup = xbt_dict_new_homogeneous(nullptr); win_lookup = xbt_dict_new_homogeneous(nullptr); info_lookup = xbt_dict_new_homogeneous(nullptr); - smpi_type_c2f(MPI_BYTE);//MPI_BYTE - smpi_type_c2f(MPI_CHAR);//MPI_CHARACTER + smpi_type_add_f(MPI_BYTE);//MPI_BYTE + smpi_type_add_f(MPI_CHAR);//MPI_CHARACTER #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__) - smpi_type_c2f(MPI_INT);//MPI_LOGICAL - smpi_type_c2f(MPI_INT);//MPI_INTEGER + smpi_type_add_f(MPI_C_BOOL);//MPI_LOGICAL + smpi_type_add_f(MPI_INT);//MPI_INTEGER #else - smpi_type_c2f(MPI_LONG);//MPI_LOGICAL - smpi_type_c2f(MPI_LONG);//MPI_INTEGER + smpi_type_add_f(MPI_C_BOOL);//MPI_LOGICAL + smpi_type_add_f(MPI_LONG);//MPI_INTEGER #endif - smpi_type_c2f(MPI_INT8_T);//MPI_INTEGER1 - smpi_type_c2f(MPI_INT16_T);//MPI_INTEGER2 - smpi_type_c2f(MPI_INT32_T);//MPI_INTEGER4 - smpi_type_c2f(MPI_INT64_T);//MPI_INTEGER8 - smpi_type_c2f(MPI_FLOAT);//MPI_REAL - smpi_type_c2f(MPI_FLOAT);//MPI_REAL4 - smpi_type_c2f(MPI_DOUBLE);//MPI_REAL8 - smpi_type_c2f(MPI_DOUBLE);//MPI_DOUBLE_PRECISION - smpi_type_c2f(MPI_C_FLOAT_COMPLEX);//MPI_COMPLEX - smpi_type_c2f(MPI_C_DOUBLE_COMPLEX);//MPI_DOUBLE_COMPLEX + smpi_type_add_f(MPI_INT8_T);//MPI_INTEGER1 + smpi_type_add_f(MPI_INT16_T);//MPI_INTEGER2 + smpi_type_add_f(MPI_INT32_T);//MPI_INTEGER4 + smpi_type_add_f(MPI_INT64_T);//MPI_INTEGER8 + smpi_type_add_f(MPI_REAL);//MPI_REAL + smpi_type_add_f(MPI_REAL4);//MPI_REAL4 + smpi_type_add_f(MPI_REAL8);//MPI_REAL8 + smpi_type_add_f(MPI_DOUBLE);//MPI_DOUBLE_PRECISION + smpi_type_add_f(MPI_C_FLOAT_COMPLEX);//MPI_COMPLEX + smpi_type_add_f(MPI_C_DOUBLE_COMPLEX);//MPI_DOUBLE_COMPLEX #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__) - smpi_type_c2f(MPI_2INT);//MPI_2INTEGER + smpi_type_add_f(MPI_2INT);//MPI_2INTEGER #else - smpi_type_c2f(MPI_2LONG);//MPI_2INTEGER + smpi_type_add_f(MPI_2LONG);//MPI_2INTEGER #endif - smpi_type_c2f(MPI_UINT8_T);//MPI_LOGICAL1 - smpi_type_c2f(MPI_UINT16_T);//MPI_LOGICAL2 - smpi_type_c2f(MPI_UINT32_T);//MPI_LOGICAL4 - smpi_type_c2f(MPI_UINT64_T);//MPI_LOGICAL8 - smpi_type_c2f(MPI_2FLOAT);//MPI_2REAL - smpi_type_c2f(MPI_2DOUBLE);//MPI_2DOUBLE_PRECISION - smpi_type_c2f(MPI_PTR);//MPI_AINT - smpi_type_c2f(MPI_UINT64_T);//MPI_OFFSET - smpi_type_c2f(MPI_UINT64_T);//MPI_COUNT - smpi_type_c2f(MPI_DATATYPE_NULL);//MPI_REAL16 - smpi_type_c2f(MPI_DATATYPE_NULL);//MPI_COMPLEX8 - smpi_type_c2f(MPI_DATATYPE_NULL);//MPI_COMPLEX16 - smpi_type_c2f(MPI_DATATYPE_NULL);//MPI_COMPLEX32 - smpi_type_c2f(MPI_DATATYPE_NULL);//MPI_PACKED + smpi_type_add_f(MPI_UINT8_T);//MPI_LOGICAL1 + smpi_type_add_f(MPI_UINT16_T);//MPI_LOGICAL2 + smpi_type_add_f(MPI_UINT32_T);//MPI_LOGICAL4 + smpi_type_add_f(MPI_UINT64_T);//MPI_LOGICAL8 + smpi_type_add_f(MPI_2FLOAT);//MPI_2REAL + smpi_type_add_f(MPI_2DOUBLE);//MPI_2DOUBLE_PRECISION + smpi_type_add_f(MPI_PTR);//MPI_AINT + smpi_type_add_f(MPI_OFFSET);//MPI_OFFSET + smpi_type_add_f(MPI_AINT);//MPI_COUNT + smpi_type_add_f(MPI_DATATYPE_NULL);//MPI_REAL16 + smpi_type_add_f(MPI_DATATYPE_NULL);//MPI_COMPLEX8 + smpi_type_add_f(MPI_DATATYPE_NULL);//MPI_COMPLEX16 + smpi_type_add_f(MPI_DATATYPE_NULL);//MPI_COMPLEX32 + smpi_type_add_f(MPI_DATATYPE_NULL);//MPI_PACKED op_lookup = xbt_dict_new_homogeneous(nullptr); - smpi_op_c2f(MPI_MAX); - smpi_op_c2f(MPI_MIN); - smpi_op_c2f(MPI_MAXLOC); - smpi_op_c2f(MPI_MINLOC); - smpi_op_c2f(MPI_SUM); - smpi_op_c2f(MPI_PROD); - smpi_op_c2f(MPI_LAND); - smpi_op_c2f(MPI_LOR); - smpi_op_c2f(MPI_LXOR); - smpi_op_c2f(MPI_BAND); - smpi_op_c2f(MPI_BOR); - smpi_op_c2f(MPI_BXOR); + smpi_op_add_f(MPI_MAX); + smpi_op_add_f(MPI_MIN); + smpi_op_add_f(MPI_MAXLOC); + smpi_op_add_f(MPI_MINLOC); + smpi_op_add_f(MPI_SUM); + smpi_op_add_f(MPI_PROD); + smpi_op_add_f(MPI_LAND); + smpi_op_add_f(MPI_LOR); + smpi_op_add_f(MPI_LXOR); + smpi_op_add_f(MPI_BAND); + smpi_op_add_f(MPI_BOR); + smpi_op_add_f(MPI_BXOR); } } -int smpi_comm_c2f(MPI_Comm comm) { - static int comm_id = 0; +template int smpi_add_f(T t, xbt_dict_t dict, int* id) { char key[KEY_SIZE]; - xbt_dict_set(comm_lookup, comm==MPI_COMM_WORLD? get_key(key, comm_id) : get_key_id(key, comm_id), comm, nullptr); - comm_id++; - return comm_id-1; + xbt_dict_set(dict, get_key(key, *id), t, nullptr); + (*id)++; + return *id-1; } -static void free_comm(int comm) { +template <> int smpi_add_f(MPI_Comm comm, xbt_dict_t dict, int* id) { char key[KEY_SIZE]; - xbt_dict_remove(comm_lookup, comm==0? get_key(key, comm) : get_key_id(key, comm)); -} - -MPI_Comm smpi_comm_f2c(int comm) { - smpi_init_fortran_types(); - if(comm == -2) { - return MPI_COMM_SELF; - } else if(comm==0){ - return MPI_COMM_WORLD; - } else if(comm_lookup != nullptr && comm >= 0) { - char key[KEY_SIZE]; - MPI_Comm tmp = static_cast(xbt_dict_get_or_null(comm_lookup,get_key_id(key, comm))); - return tmp != nullptr ? tmp : MPI_COMM_NULL ; - } else { - return MPI_COMM_NULL; - } -} - -int smpi_group_c2f(MPI_Group group) { - static int group_id = 0; - char key[KEY_SIZE]; - xbt_dict_set(group_lookup, get_key(key, group_id), group, nullptr); - group_id++; - return group_id-1; -} - -MPI_Group smpi_group_f2c(int group) { - smpi_init_fortran_types(); - if(group == -2) { - return MPI_GROUP_EMPTY; - } else if(group_lookup != nullptr && group >= 0) { - char key[KEY_SIZE]; - return static_cast(xbt_dict_get_or_null(group_lookup, get_key(key, group))); - } else { - return MPI_GROUP_NULL; - } + xbt_dict_set(dict, comm==MPI_COMM_WORLD? get_key(key, *id) : get_key_id(key, *id), comm, nullptr); + (*id)++; + return *id-1; } -static void free_group(int group) { +template <> int smpi_add_f(MPI_Request request, xbt_dict_t dict, int* id) { char key[KEY_SIZE]; - xbt_dict_remove(group_lookup, get_key(key, group)); + xbt_dict_set(dict, get_key_id(key, *id), request, nullptr); + (*id)++; + return *id-1; } -int smpi_request_c2f(MPI_Request req) { - static int request_id = 0; - char key[KEY_SIZE]; - xbt_dict_set(request_lookup, get_key_id(key, request_id), req, nullptr); - request_id++; - return request_id-1; +template int smpi_c2f(T t, xbt_dict_t dict, int* id) { + char* existing_key = xbt_dict_get_key(dict, t); + if(existing_key!=nullptr) + return atoi(existing_key); + else + return smpi_add_f(t,dict,id); } -MPI_Request smpi_request_f2c(int req) { - smpi_init_fortran_types(); +template void free_f(int id, xbt_dict_t dict) { char key[KEY_SIZE]; - if(req==MPI_FORTRAN_REQUEST_NULL) - return MPI_REQUEST_NULL; - return static_cast(xbt_dict_get(request_lookup, get_key_id(key, req))); + xbt_dict_remove(dict, get_key(key, id)); } -static void free_request(int request) { +template <> void free_f(int id, xbt_dict_t dict) { char key[KEY_SIZE]; - if(request!=MPI_FORTRAN_REQUEST_NULL) - xbt_dict_remove(request_lookup, get_key_id(key, request)); + xbt_dict_remove(dict, id==0? get_key(key, id) : get_key_id(key, id)); } -int smpi_type_c2f(MPI_Datatype datatype) { - static int datatype_id = 0; +template <> void free_f(int id, xbt_dict_t dict) { char key[KEY_SIZE]; - xbt_dict_set(datatype_lookup, get_key(key, datatype_id), datatype, nullptr); - datatype_id++; - return datatype_id-1; + if(id!=MPI_FORTRAN_REQUEST_NULL) + xbt_dict_remove(dict, get_key_id(key, id)); } -MPI_Datatype smpi_type_f2c(int datatype) { +template T smpi_f2c(int id, xbt_dict_t dict, void* null_id ) { smpi_init_fortran_types(); char key[KEY_SIZE]; - return datatype >= 0 ? static_cast(xbt_dict_get_or_null(datatype_lookup, get_key(key, datatype))): MPI_DATATYPE_NULL; -} - -static void free_datatype(int datatype) { - char key[KEY_SIZE]; - xbt_dict_remove(datatype_lookup, get_key(key, datatype)); -} - -int smpi_op_c2f(MPI_Op op) { - static int op_id = 0; - char key[KEY_SIZE]; - xbt_dict_set(op_lookup, get_key(key, op_id), op, nullptr); - op_id++; - return op_id-1; + return id >= 0 ? static_cast(xbt_dict_get_or_null(dict, get_key(key, id))): static_cast(null_id); } -MPI_Op smpi_op_f2c(int op) { +template <> MPI_Comm smpi_f2c(int comm, xbt_dict_t dict, void* null_id) { smpi_init_fortran_types(); - char key[KEY_SIZE]; - return op >= 0 ? static_cast(xbt_dict_get_or_null(op_lookup, get_key(key, op))): MPI_OP_NULL; -} - -static void free_op(int op) { - char key[KEY_SIZE]; - xbt_dict_remove(op_lookup, get_key(key, op)); -} - -int smpi_win_c2f(MPI_Win win) { - static int win_id = 0; - char key[KEY_SIZE]; - xbt_dict_set(win_lookup, get_key(key, win_id), win, nullptr); - win_id++; - return win_id-1; + if(comm == -2) { + return MPI_COMM_SELF; + } else if(comm==0){ + return MPI_COMM_WORLD; + } else if(dict != nullptr && comm >= 0) { + char key[KEY_SIZE]; + MPI_Comm tmp = static_cast(xbt_dict_get_or_null(dict,get_key_id(key, comm))); + return tmp != nullptr ? tmp : static_cast(null_id) ; + } else { + return static_cast(null_id); + } } -MPI_Win smpi_win_f2c(int win) { +template <> MPI_Group smpi_f2c(int group, xbt_dict_t dict, void* null_id) { smpi_init_fortran_types(); - char key[KEY_SIZE]; - return win >= 0 ? static_cast(xbt_dict_get_or_null(win_lookup, get_key(key, win))) : MPI_WIN_NULL; -} - -static void free_win(int win) { - char key[KEY_SIZE]; - xbt_dict_remove(win_lookup, get_key(key, win)); -} - -int smpi_info_c2f(MPI_Info info) { - static int info_id = 0; - char key[KEY_SIZE]; - xbt_dict_set(info_lookup, get_key(key, info_id), info, nullptr); - info_id++; - return info_id-1; + if(group == -2) { + return MPI_GROUP_EMPTY; + } else if(dict != nullptr && group >= 0) { + char key[KEY_SIZE]; + return static_cast(xbt_dict_get_or_null(dict, get_key(key, group))); + } else { + return static_cast(null_id); + } } -MPI_Info smpi_info_f2c(int info) { +template <> MPI_Request smpi_f2c(int request, xbt_dict_t dict, void* null_id) { smpi_init_fortran_types(); char key[KEY_SIZE]; - return info >= 0 ? static_cast(xbt_dict_get_or_null(info_lookup, get_key(key, info))) : MPI_INFO_NULL; -} - -static void free_info(int info) { - char key[KEY_SIZE]; - xbt_dict_remove(info_lookup, get_key(key, info)); -} + if(request==MPI_FORTRAN_REQUEST_NULL) + return static_cast(null_id); + return static_cast(xbt_dict_get(dict, get_key_id(key, request))); +} + +#define SMPI_F2C_C2F(type, name, null_id)\ +int smpi_##name##_add_f(type name){\ + return smpi_add_f(name, name##_lookup, &name##_id);\ +}\ +int smpi_##name##_c2f(type name){\ + return smpi_c2f(name, name##_lookup, &name##_id);\ +}\ +static void free_##name(int id) {\ + free_f(id, name##_lookup);\ +}\ +type smpi_##name##_f2c(int id){\ + return smpi_f2c(id, name##_lookup, static_cast(null_id));\ +} + +extern "C" { // This should really use the C linkage to be usable from Fortran + +SMPI_F2C_C2F(MPI_Comm, comm, MPI_COMM_NULL) +SMPI_F2C_C2F(MPI_Group, group, MPI_GROUP_NULL) +SMPI_F2C_C2F(MPI_Request, request, MPI_REQUEST_NULL) +SMPI_F2C_C2F(MPI_Datatype, type, MPI_DATATYPE_NULL) +SMPI_F2C_C2F(MPI_Win, win, MPI_WIN_NULL) +SMPI_F2C_C2F(MPI_Op, op, MPI_OP_NULL) +SMPI_F2C_C2F(MPI_Info, info, MPI_INFO_NULL) void mpi_init_(int* ierr) { smpi_init_fortran_types(); @@ -282,7 +240,7 @@ void mpi_finalize_(int* ierr) { running_processes--; if(running_processes==0){ xbt_dict_free(&op_lookup); - xbt_dict_free(&datatype_lookup); + xbt_dict_free(&type_lookup); xbt_dict_free(&request_lookup); xbt_dict_free(&group_lookup); xbt_dict_free(&comm_lookup); @@ -316,7 +274,7 @@ void mpi_comm_dup_(int* comm, int* newcomm, int* ierr) { *ierr = MPI_Comm_dup(smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *newcomm = smpi_comm_c2f(tmp); + *newcomm = smpi_comm_add_f(tmp); } } @@ -325,7 +283,7 @@ void mpi_comm_create_(int* comm, int* group, int* newcomm, int* ierr) { *ierr = MPI_Comm_create(smpi_comm_f2c(*comm),smpi_group_f2c(*group), &tmp); if(*ierr == MPI_SUCCESS) { - *newcomm = smpi_comm_c2f(tmp); + *newcomm = smpi_comm_add_f(tmp); } } @@ -344,7 +302,7 @@ void mpi_comm_split_(int* comm, int* color, int* key, int* comm_out, int* ierr) *ierr = MPI_Comm_split(smpi_comm_f2c(*comm), *color, *key, &tmp); if(*ierr == MPI_SUCCESS) { - *comm_out = smpi_comm_c2f(tmp); + *comm_out = smpi_comm_add_f(tmp); } } @@ -353,7 +311,7 @@ void mpi_group_incl_(int* group, int* n, int* ranks, int* group_out, int* ierr) *ierr = MPI_Group_incl(smpi_group_f2c(*group), *n, ranks, &tmp); if(*ierr == MPI_SUCCESS) { - *group_out = smpi_group_c2f(tmp); + *group_out = smpi_group_add_f(tmp); } } @@ -375,7 +333,7 @@ void mpi_send_init_(void *buf, int* count, int* datatype, int* dst, int* tag, in buf = static_cast(FORT_BOTTOM(buf)); *ierr = MPI_Send_init(buf, *count, smpi_type_f2c(*datatype), *dst, *tag, smpi_comm_f2c(*comm), &req); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(req); + *request = smpi_request_add_f(req); } } @@ -384,7 +342,7 @@ void mpi_isend_(void *buf, int* count, int* datatype, int* dst, int* tag, int* c buf = static_cast(FORT_BOTTOM(buf)); *ierr = MPI_Isend(buf, *count, smpi_type_f2c(*datatype), *dst, *tag, smpi_comm_f2c(*comm), &req); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(req); + *request = smpi_request_add_f(req); } } @@ -393,7 +351,7 @@ void mpi_irsend_(void *buf, int* count, int* datatype, int* dst, int* tag, int* buf = static_cast(FORT_BOTTOM(buf)); *ierr = MPI_Irsend(buf, *count, smpi_type_f2c(*datatype), *dst, *tag, smpi_comm_f2c(*comm), &req); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(req); + *request = smpi_request_add_f(req); } } @@ -420,7 +378,7 @@ void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag, in buf = static_cast( FORT_BOTTOM(buf)); *ierr = MPI_Recv_init(buf, *count, smpi_type_f2c(*datatype), *src, *tag, smpi_comm_f2c(*comm), &req); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(req); + *request = smpi_request_add_f(req); } } @@ -429,7 +387,7 @@ void mpi_irecv_(void *buf, int* count, int* datatype, int* src, int* tag, int* c buf = static_cast( FORT_BOTTOM(buf)); *ierr = MPI_Irecv(buf, *count, smpi_type_f2c(*datatype), *src, *tag, smpi_comm_f2c(*comm), &req); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(req); + *request = smpi_request_add_f(req); } } @@ -544,7 +502,7 @@ void mpi_scatterv_(void* sendbuf, int* sendcounts, int* displs, int* sendtype, void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, int* recvcount, int* recvtype, int* root, int* comm, int* ierr) { sendbuf = static_cast( FORT_IN_PLACE(sendbuf)); - sendbuf = static_cast( FORT_BOTTOM(sendbuf)); + sendbuf = sendbuf!=MPI_IN_PLACE ? static_cast( FORT_BOTTOM(sendbuf)) : MPI_IN_PLACE; recvbuf = static_cast( FORT_BOTTOM(recvbuf)); *ierr = MPI_Gather(sendbuf, *sendcount, smpi_type_f2c(*sendtype), recvbuf, *recvcount, smpi_type_f2c(*recvtype), *root, smpi_comm_f2c(*comm)); @@ -553,7 +511,7 @@ void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, in void mpi_gatherv_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, int* recvcounts, int* displs, int* recvtype, int* root, int* comm, int* ierr) { sendbuf = static_cast( FORT_IN_PLACE(sendbuf)); - sendbuf = static_cast( FORT_BOTTOM(sendbuf)); + sendbuf = sendbuf!=MPI_IN_PLACE ? static_cast( FORT_BOTTOM(sendbuf)) : MPI_IN_PLACE; recvbuf = static_cast( FORT_BOTTOM(recvbuf)); *ierr = MPI_Gatherv(sendbuf, *sendcount, smpi_type_f2c(*sendtype), recvbuf, recvcounts, displs, smpi_type_f2c(*recvtype), *root, smpi_comm_f2c(*comm)); @@ -600,9 +558,8 @@ void mpi_test_ (int * request, int *flag, MPI_Status * status, int* ierr){ } void mpi_testall_ (int* count, int * requests, int *flag, MPI_Status * statuses, int* ierr){ - MPI_Request* reqs; int i; - reqs = xbt_new(MPI_Request, *count); + MPI_Request* reqs = xbt_new(MPI_Request, *count); for(i = 0; i < *count; i++) { reqs[i] = smpi_request_f2c(requests[i]); } @@ -613,6 +570,7 @@ void mpi_testall_ (int* count, int * requests, int *flag, MPI_Status * statuses requests[i]=MPI_FORTRAN_REQUEST_NULL; } } + xbt_free(reqs); } void mpi_get_processor_name_(char *name, int *resultlen, int* ierr){ @@ -640,7 +598,7 @@ void mpi_type_vector_(int* count, int* blocklen, int* stride, int* old_type, int MPI_Datatype tmp; *ierr= MPI_Type_vector(*count, *blocklen, *stride, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -648,7 +606,7 @@ void mpi_type_create_vector_(int* count, int* blocklen, int* stride, int* old_ty MPI_Datatype tmp; *ierr= MPI_Type_vector(*count, *blocklen, *stride, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -656,7 +614,7 @@ void mpi_type_hvector_(int* count, int* blocklen, MPI_Aint* stride, int* old_typ MPI_Datatype tmp; *ierr= MPI_Type_hvector (*count, *blocklen, *stride, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -664,7 +622,7 @@ void mpi_type_create_hvector_(int* count, int* blocklen, MPI_Aint* stride, int* MPI_Datatype tmp; *ierr= MPI_Type_hvector(*count, *blocklen, *stride, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -672,7 +630,7 @@ void mpi_type_free_(int* datatype, int* ierr){ MPI_Datatype tmp= smpi_type_f2c(*datatype); *ierr= MPI_Type_free (&tmp); if(*ierr == MPI_SUCCESS) { - free_datatype(*datatype); + free_type(*datatype); } } @@ -709,7 +667,7 @@ void mpi_win_create_( int *base, MPI_Aint* size, int* disp_unit, int* info, int* MPI_Win tmp; *ierr = MPI_Win_create( static_cast(base), *size, *disp_unit, smpi_info_f2c(*info), smpi_comm_f2c(*comm),&tmp); if(*ierr == MPI_SUCCESS) { - *win = smpi_win_c2f(tmp); + *win = smpi_win_add_f(tmp); } } @@ -754,7 +712,7 @@ void mpi_info_create_( int *info, int* ierr){ MPI_Info tmp; *ierr = MPI_Info_create(&tmp); if(*ierr == MPI_SUCCESS) { - *info = smpi_info_c2f(tmp); + *info = smpi_info_add_f(tmp); } } @@ -778,10 +736,11 @@ void mpi_info_set_( int *info, char *key, char *value, int* ierr, unsigned int k } char* tvalue = xbt_new(char,valuelen+1); strncpy(tvalue, value, valuelen); - tvalue[valuelen]='\0'; + *ierr = MPI_Info_set( smpi_info_f2c(*info), tkey, tvalue); xbt_free(tkey); + xbt_free(tvalue); } void mpi_info_get_ (int* info,char *key,int* valuelen, char *value, int *flag, int* ierr, unsigned int keylen ){ @@ -870,7 +829,7 @@ void mpi_type_dup_ (int* datatype, int* newdatatype, int* ierr){ MPI_Datatype tmp; *ierr = MPI_Type_dup(smpi_type_f2c(*datatype), &tmp); if(*ierr == MPI_SUCCESS) { - *newdatatype = smpi_type_c2f(tmp); + *newdatatype = smpi_type_add_f(tmp); } } @@ -931,7 +890,8 @@ void mpi_op_create_ (void * function, int* commute, int* op, int* ierr){ MPI_Op tmp; *ierr = MPI_Op_create(reinterpret_cast(function),*commute, &tmp); if(*ierr == MPI_SUCCESS) { - *op = smpi_op_c2f(tmp); + smpi_op_set_fortran(tmp); + *op = smpi_op_add_f(tmp); } } @@ -976,7 +936,7 @@ void mpi_group_union_ (int* group1, int* group2, int* newgroup, int* ierr){ MPI_Group tmp; *ierr = MPI_Group_union(smpi_group_f2c(*group1), smpi_group_f2c(*group2), &tmp); if(*ierr == MPI_SUCCESS) { - *newgroup = smpi_group_c2f(tmp); + *newgroup = smpi_group_add_f(tmp); } } @@ -984,7 +944,7 @@ void mpi_group_intersection_ (int* group1, int* group2, int* newgroup, int* ierr MPI_Group tmp; *ierr = MPI_Group_intersection(smpi_group_f2c(*group1), smpi_group_f2c(*group2), &tmp); if(*ierr == MPI_SUCCESS) { - *newgroup = smpi_group_c2f(tmp); + *newgroup = smpi_group_add_f(tmp); } } @@ -992,7 +952,7 @@ void mpi_group_difference_ (int* group1, int* group2, int* newgroup, int* ierr){ MPI_Group tmp; *ierr = MPI_Group_difference(smpi_group_f2c(*group1), smpi_group_f2c(*group2), &tmp); if(*ierr == MPI_SUCCESS) { - *newgroup = smpi_group_c2f(tmp); + *newgroup = smpi_group_add_f(tmp); } } @@ -1000,7 +960,7 @@ void mpi_group_excl_ (int* group, int* n, int *ranks, int* newgroup, int* ierr){ MPI_Group tmp; *ierr = MPI_Group_excl(smpi_group_f2c(*group), *n, ranks, &tmp); if(*ierr == MPI_SUCCESS) { - *newgroup = smpi_group_c2f(tmp); + *newgroup = smpi_group_add_f(tmp); } } @@ -1009,7 +969,7 @@ void mpi_group_range_incl_ (int* group, int* n, int ranges[][3], int* newgroup, MPI_Group tmp; *ierr = MPI_Group_range_incl(smpi_group_f2c(*group), *n, ranges, &tmp); if(*ierr == MPI_SUCCESS) { - *newgroup = smpi_group_c2f(tmp); + *newgroup = smpi_group_add_f(tmp); } } @@ -1018,7 +978,7 @@ void mpi_group_range_excl_ (int* group, int* n, int ranges[][3], int* newgroup, MPI_Group tmp; *ierr = MPI_Group_range_excl(smpi_group_f2c(*group), *n, ranges, &tmp); if(*ierr == MPI_SUCCESS) { - *newgroup = smpi_group_c2f(tmp); + *newgroup = smpi_group_add_f(tmp); } } @@ -1142,7 +1102,7 @@ void mpi_cart_create_ (int* comm_old, int* ndims, int* dims, int* periods, int* MPI_Comm tmp; *ierr = MPI_Cart_create(smpi_comm_f2c(*comm_old), *ndims, dims, periods, *reorder, &tmp); if(*ierr == MPI_SUCCESS) { - *comm_cart = smpi_comm_c2f(tmp); + *comm_cart = smpi_comm_add_f(tmp); } } @@ -1166,7 +1126,7 @@ void mpi_cart_sub_ (int* comm, int* remain_dims, int* comm_new, int* ierr) { MPI_Comm tmp; *ierr = MPI_Cart_sub(smpi_comm_f2c(*comm), remain_dims, &tmp); if(*ierr == MPI_SUCCESS) { - *comm_new = smpi_comm_c2f(tmp); + *comm_new = smpi_comm_add_f(tmp); } } @@ -1178,7 +1138,7 @@ void mpi_graph_create_ (int* comm_old, int* nnodes, int* index, int* edges, int* MPI_Comm tmp; *ierr = MPI_Graph_create(smpi_comm_f2c(*comm_old), *nnodes, index, edges, *reorder, &tmp); if(*ierr == MPI_SUCCESS) { - *comm_graph = smpi_comm_c2f(tmp); + *comm_graph = smpi_comm_add_f(tmp); } } @@ -1238,7 +1198,7 @@ void mpi_type_contiguous_ (int* count, int* old_type, int* newtype, int* ierr) MPI_Datatype tmp; *ierr = MPI_Type_contiguous(*count, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1301,7 +1261,7 @@ void mpi_type_hindexed_ (int* count, int* blocklens, MPI_Aint* indices, int* old MPI_Datatype tmp; *ierr = MPI_Type_hindexed(*count, blocklens, indices, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1309,7 +1269,7 @@ void mpi_type_create_hindexed_(int* count, int* blocklens, MPI_Aint* indices, in MPI_Datatype tmp; *ierr = MPI_Type_create_hindexed(*count, blocklens, indices, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1318,7 +1278,7 @@ void mpi_type_create_hindexed_block_ (int* count, int* blocklength, MPI_Aint* in MPI_Datatype tmp; *ierr = MPI_Type_create_hindexed_block(*count, *blocklength, indices, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1326,7 +1286,7 @@ void mpi_type_indexed_ (int* count, int* blocklens, int* indices, int* old_type, MPI_Datatype tmp; *ierr = MPI_Type_indexed(*count, blocklens, indices, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1335,7 +1295,7 @@ void mpi_type_create_indexed_block_ (int* count, int* blocklength, int* indices, MPI_Datatype tmp; *ierr = MPI_Type_create_indexed_block(*count, *blocklength, indices, smpi_type_f2c(*old_type), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1348,7 +1308,7 @@ void mpi_type_struct_ (int* count, int* blocklens, MPI_Aint* indices, int* old_t } *ierr = MPI_Type_struct(*count, blocklens, indices, types, &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } xbt_free(types); } @@ -1362,7 +1322,7 @@ void mpi_type_create_struct_(int* count, int* blocklens, MPI_Aint* indices, int* } *ierr = MPI_Type_create_struct(*count, blocklens, indices, types, &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } xbt_free(types); } @@ -1375,7 +1335,7 @@ void mpi_ssend_init_ (void* buf, int* count, int* datatype, int* dest, int* tag, MPI_Request tmp; *ierr = MPI_Ssend_init(buf, *count, smpi_type_f2c(*datatype), *dest, *tag, smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(tmp); + *request = smpi_request_add_f(tmp); } } @@ -1385,7 +1345,7 @@ void mpi_intercomm_create_ (int* local_comm, int *local_leader, int* peer_comm, *ierr = MPI_Intercomm_create(smpi_comm_f2c(*local_comm), *local_leader,smpi_comm_f2c(*peer_comm), *remote_leader, *tag, &tmp); if(*ierr == MPI_SUCCESS) { - *comm_out = smpi_comm_c2f(tmp); + *comm_out = smpi_comm_add_f(tmp); } } @@ -1393,7 +1353,7 @@ void mpi_intercomm_merge_ (int* comm, int* high, int* comm_out, int* ierr) { MPI_Comm tmp; *ierr = MPI_Intercomm_merge(smpi_comm_f2c(*comm), *high, &tmp); if(*ierr == MPI_SUCCESS) { - *comm_out = smpi_comm_c2f(tmp); + *comm_out = smpi_comm_add_f(tmp); } } @@ -1405,7 +1365,7 @@ void mpi_bsend_init_ (void* buf, int* count, int* datatype, int *dest, int* tag, MPI_Request tmp; *ierr = MPI_Bsend_init(buf, *count, smpi_type_f2c(*datatype), *dest, *tag, smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(tmp); + *request = smpi_request_add_f(tmp); } } @@ -1413,7 +1373,7 @@ void mpi_ibsend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int MPI_Request tmp; *ierr = MPI_Ibsend(buf, *count, smpi_type_f2c(*datatype), *dest, *tag, smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(tmp); + *request = smpi_request_add_f(tmp); } } @@ -1433,7 +1393,7 @@ void mpi_issend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int MPI_Request tmp; *ierr = MPI_Issend(buf, *count, smpi_type_f2c(*datatype), *dest, *tag, smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(tmp); + *request = smpi_request_add_f(tmp); } } @@ -1453,7 +1413,7 @@ void mpi_rsend_init_ (void* buf, int* count, int* datatype, int *dest, int* tag, MPI_Request tmp; *ierr = MPI_Rsend_init(buf, *count, smpi_type_f2c(*datatype), *dest, *tag, smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(tmp); + *request = smpi_request_add_f(tmp); } } @@ -1506,7 +1466,7 @@ void mpi_type_create_darray_ (int* size, int* rank, int* ndims, int* array_of_gs array_of_distribs, array_of_dargs, array_of_psizes, *order, smpi_type_f2c(*oldtype), &tmp) ; if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1514,7 +1474,7 @@ void mpi_type_create_resized_ (int* oldtype,MPI_Aint* lb, MPI_Aint* extent, int* MPI_Datatype tmp; *ierr = MPI_Type_create_resized(smpi_type_f2c(*oldtype),*lb, *extent, &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1524,7 +1484,7 @@ void mpi_type_create_subarray_ (int* ndims,int *array_of_sizes, int *array_of_su *ierr = MPI_Type_create_subarray(*ndims,array_of_sizes, array_of_subsizes, array_of_starts, *order, smpi_type_f2c(*oldtype), &tmp); if(*ierr == MPI_SUCCESS) { - *newtype = smpi_type_c2f(tmp); + *newtype = smpi_type_add_f(tmp); } } @@ -1558,7 +1518,7 @@ void mpi_comm_dup_with_info_ (int* comm, int* info, int* newcomm, int* ierr){ MPI_Comm tmp; *ierr = MPI_Comm_dup_with_info(smpi_comm_f2c(*comm),smpi_info_f2c(*info),&tmp); if(*ierr == MPI_SUCCESS) { - *newcomm = smpi_comm_c2f(tmp); + *newcomm = smpi_comm_add_f(tmp); } } @@ -1566,7 +1526,7 @@ void mpi_comm_split_type_ (int* comm, int* split_type, int* key, int* info, int* MPI_Comm tmp; *ierr = MPI_Comm_split_type(smpi_comm_f2c(*comm), *split_type, *key, smpi_info_f2c(*info), &tmp); if(*ierr == MPI_SUCCESS) { - *newcomm = smpi_comm_c2f(tmp); + *newcomm = smpi_comm_add_f(tmp); } } @@ -1606,7 +1566,7 @@ void mpi_info_dup_ (int* info, int* newinfo, int* ierr){ MPI_Info tmp; *ierr = MPI_Info_dup(smpi_info_f2c(*info), &tmp); if(*ierr==MPI_SUCCESS){ - *newinfo= smpi_info_c2f(tmp); + *newinfo= smpi_info_add_f(tmp); } } @@ -1666,7 +1626,7 @@ void mpi_grequest_start_ ( void *query_fn, void *free_fn, void *cancel_fn, void *ierr = MPI_Grequest_start( reinterpret_cast(query_fn), reinterpret_cast(free_fn), reinterpret_cast(cancel_fn), extra_state, &tmp); if(*ierr == MPI_SUCCESS) { - *request = smpi_request_c2f(tmp); + *request = smpi_request_add_f(tmp); } } @@ -1686,7 +1646,7 @@ void mpi_comm_connect_ ( char *port_name, int* info, int* root, int* comm, int*n MPI_Comm tmp; *ierr = MPI_Comm_connect( port_name, *reinterpret_cast(info), *root, smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *newcomm = smpi_comm_c2f(tmp); + *newcomm = smpi_comm_add_f(tmp); } } @@ -1706,7 +1666,7 @@ void mpi_comm_join_ ( int* fd, int* intercomm, int* ierr){ MPI_Comm tmp; *ierr = MPI_Comm_join( *fd, &tmp); if(*ierr == MPI_SUCCESS) { - *intercomm = smpi_comm_c2f(tmp); + *intercomm = smpi_comm_add_f(tmp); } } @@ -1722,7 +1682,7 @@ void mpi_comm_accept_ ( char *port_name, int* info, int* root, int* comm, int*ne MPI_Comm tmp; *ierr = MPI_Comm_accept( port_name, *reinterpret_cast(info), *root, smpi_comm_f2c(*comm), &tmp); if(*ierr == MPI_SUCCESS) { - *newcomm = smpi_comm_c2f(tmp); + *newcomm = smpi_comm_add_f(tmp); } } @@ -1732,7 +1692,7 @@ void mpi_comm_spawn_ ( char *command, char *argv, int* maxprocs, int* info, int* *ierr = MPI_Comm_spawn( command, nullptr, *maxprocs, *reinterpret_cast(info), *root, smpi_comm_f2c(*comm), &tmp, array_of_errcodes); if(*ierr == MPI_SUCCESS) { - *intercomm = smpi_comm_c2f(tmp); + *intercomm = smpi_comm_add_f(tmp); } } @@ -1743,7 +1703,7 @@ void mpi_comm_spawn_multiple_ ( int* count, char *array_of_commands, char** arra *ierr = MPI_Comm_spawn_multiple(* count, &array_of_commands, &array_of_argv, array_of_maxprocs, reinterpret_cast(array_of_info), *root, smpi_comm_f2c(*comm), &tmp, array_of_errcodes); if(*ierr == MPI_SUCCESS) { - *intercomm = smpi_comm_c2f(tmp); + *intercomm = smpi_comm_add_f(tmp); } } @@ -1754,3 +1714,29 @@ void mpi_comm_get_parent_ ( int* parent, int* ierr){ *parent = smpi_comm_c2f(tmp); } } + +void mpi_file_close_ ( int* file, int* ierr){ + *ierr= MPI_File_close(reinterpret_cast(*file)); +} + +void mpi_file_delete_ ( char* filename, int* info, int* ierr){ + *ierr= MPI_File_delete(filename, smpi_info_f2c(*info)); +} + +void mpi_file_open_ ( int* comm, char* filename, int* amode, int* info, int* fh, int* ierr){ + *ierr= MPI_File_open(smpi_comm_f2c(*comm), filename, *amode, smpi_info_f2c(*info), reinterpret_cast(*fh)); +} + +void mpi_file_set_view_ ( int* fh, long long int* offset, int* etype, int* filetype, char* datarep, int* info, int* ierr){ + *ierr= MPI_File_set_view(reinterpret_cast(*fh) , reinterpret_cast(*offset), smpi_type_f2c(*etype), smpi_type_f2c(*filetype), datarep, smpi_info_f2c(*info)); +} + +void mpi_file_read_ ( int* fh, void* buf, int* count, int* datatype, MPI_Status* status, int* ierr){ + *ierr= MPI_File_read(reinterpret_cast(*fh), buf, *count, smpi_type_f2c(*datatype), status); +} + +void mpi_file_write_ ( int* fh, void* buf, int* count, int* datatype, MPI_Status* status, int* ierr){ + *ierr= MPI_File_write(reinterpret_cast(*fh), buf, *count, smpi_type_f2c(*datatype), status); +} + +} // extern "C"