X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/d9cdd4e949306eb118d2f1d7e51af1550bb61e7c..f055485dd028f6dc2dece9800fdda09e84c20ac8:/src/smpi/smpi_f77.c diff --git a/src/smpi/smpi_f77.c b/src/smpi/smpi_f77.c index e6e20f229c..fa9a80075d 100644 --- a/src/smpi/smpi_f77.c +++ b/src/smpi/smpi_f77.c @@ -1,8 +1,8 @@ -/* Copyright (c) 2010. The SimGrid Team. +/* Copyright (c) 2010-2014. The SimGrid Team. * All rights reserved. */ /* This program is free software; you can redistribute it and/or modify it - * under the terms of the license (GNU LGPL) which comes with this package. */ + * under the terms of the license (GNU LGPL) which comes with this package. */ #include #include @@ -13,113 +13,168 @@ extern int xargc; extern char** xargv; -static xbt_dynar_t comm_lookup = NULL; -static xbt_dynar_t group_lookup = NULL; +static xbt_dict_t comm_lookup = NULL; +static xbt_dict_t group_lookup = NULL; static xbt_dict_t request_lookup = NULL; -static xbt_dynar_t datatype_lookup = NULL; -static xbt_dynar_t op_lookup = NULL; +static xbt_dict_t datatype_lookup = NULL; +static xbt_dict_t op_lookup = NULL; +static int running_processes = 0; + +/* Bindings for MPI special values */ +union u_smpi_common { + struct s_smpi_common { + integer _MPI_IN_PLACE; + integer _MPI_BOTTOM; + integer _MPI_STATUS_IGNORE; + integer _MPI_STATUSES_IGNORE; + } f90; /* with gftortran */ + struct s_smpi_common *f77; /* with f2c, remains NULL with gfortran */ +} smpi_; + +/* Convert between Fortran and C */ +#define F2C_ADDR(addr, val) \ + (((void *)(addr) == (void *)(smpi_.f77 \ + ? &smpi_.f77[smpi_current_rank]._ ## val \ + : &smpi_.f90._ ## val)) \ + ? (val) : (void *)(addr)) +#define F2C_BOTTOM(addr) F2C_ADDR(addr, MPI_BOTTOM) +#define F2C_IN_PLACE(addr) F2C_ADDR(addr, MPI_IN_PLACE) +#define F2C_STATUS_IGNORE(addr) F2C_ADDR(addr, MPI_STATUS_IGNORE) +#define F2C_STATUSES_IGNORE(addr) F2C_ADDR(addr, MPI_STATUSES_IGNORE) #define KEY_SIZE (sizeof(int) * 2 + 1) + +static char* get_key(char* key, int id) { + snprintf(key, KEY_SIZE, "%x",id); + return key; +} +static char* get_key_id(char* key, int id) { + snprintf(key, KEY_SIZE, "%x_%d",id, smpi_process_index()); + return key; +} + static int new_comm(MPI_Comm comm) { - xbt_dynar_push(comm_lookup, &comm); - return (int)xbt_dynar_length(comm_lookup) - 1; + static int comm_id = 0; + 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, NULL); + comm_id++; + return comm_id-1; } static void free_comm(int comm) { - xbt_dynar_remove_at(comm_lookup, comm, NULL); + char key[KEY_SIZE]; + xbt_dict_remove(comm_lookup, comm==0? get_key(key, comm) : get_key_id(key, comm)); } static MPI_Comm get_comm(int comm) { if(comm == -2) { return MPI_COMM_SELF; - } else if(comm_lookup && comm >= 0 && comm < (int)xbt_dynar_length(comm_lookup)) { - return *(MPI_Comm*)xbt_dynar_get_ptr(comm_lookup, comm); + }else if(comm==0){ + return MPI_COMM_WORLD; + } else if(comm_lookup && comm >= 0) { + + char key[KEY_SIZE]; + MPI_Comm tmp = (MPI_Comm)xbt_dict_get_or_null(comm_lookup,get_key_id(key, comm)); + return tmp != NULL ? tmp : MPI_COMM_NULL ; } return MPI_COMM_NULL; } static int new_group(MPI_Group group) { - xbt_dynar_push(group_lookup, &group); - return (int)xbt_dynar_length(group_lookup) - 1; + static int group_id = 0; + char key[KEY_SIZE]; + xbt_dict_set(group_lookup, get_key(key, group_id), group, NULL); + group_id++; + return group_id-1; } static MPI_Group get_group(int group) { if(group == -2) { return MPI_GROUP_EMPTY; - } else if(group_lookup && group >= 0 && group < (int)xbt_dynar_length(group_lookup)) { - return *(MPI_Group*)xbt_dynar_get_ptr(group_lookup, group); + } else if(group_lookup && group >= 0) { + char key[KEY_SIZE]; + return (MPI_Group)xbt_dict_get_or_null(group_lookup, get_key(key, group)); } - return MPI_COMM_NULL; + return MPI_GROUP_NULL; } static void free_group(int group) { - xbt_dynar_remove_at(group_lookup, group, NULL); + char key[KEY_SIZE]; + xbt_dict_remove(group_lookup, get_key(key, group)); } -static char* get_key(char* key, int id) { - snprintf(key, KEY_SIZE, "%x", id); - return key; -} + static int new_request(MPI_Request req) { static int request_id = INT_MIN; char key[KEY_SIZE]; - - xbt_dict_set(request_lookup, get_key(key, request_id), req, NULL); - return request_id++; + xbt_dict_set(request_lookup, get_key_id(key, request_id), req, NULL); + request_id++; + return request_id-1; } static MPI_Request find_request(int req) { char key[KEY_SIZE]; - - return (MPI_Request)xbt_dict_get(request_lookup, get_key(key, req)); + if(req==MPI_FORTRAN_REQUEST_NULL)return MPI_REQUEST_NULL; + return (MPI_Request)xbt_dict_get(request_lookup, get_key_id(key, req)); } static void free_request(int request) { char key[KEY_SIZE]; - xbt_dict_remove(request_lookup, get_key(key, request)); + if(request!=MPI_FORTRAN_REQUEST_NULL) + xbt_dict_remove(request_lookup, get_key_id(key, request)); } static int new_datatype(MPI_Datatype datatype) { - xbt_dynar_push(datatype_lookup, &datatype); - return (int)xbt_dynar_length(datatype_lookup) - 1; + static int datatype_id = 0; + char key[KEY_SIZE]; + xbt_dict_set(datatype_lookup, get_key(key, datatype_id), datatype, NULL); + datatype_id++; + return datatype_id-1; } static MPI_Datatype get_datatype(int datatype) { + char key[KEY_SIZE]; return datatype >= 0 - ? *(MPI_Datatype*)xbt_dynar_get_ptr(datatype_lookup, datatype) + ? (MPI_Datatype)xbt_dict_get_or_null(datatype_lookup, get_key(key, datatype)) : MPI_DATATYPE_NULL; } static void free_datatype(int datatype) { - xbt_dynar_remove_at(datatype_lookup, datatype, NULL); + char key[KEY_SIZE]; + xbt_dict_remove(datatype_lookup, get_key(key, datatype)); } static int new_op(MPI_Op op) { - xbt_dynar_push(op_lookup, &op); - return (int)xbt_dynar_length(op_lookup) - 1; + static int op_id = 0; + char key[KEY_SIZE]; + xbt_dict_set(op_lookup, get_key(key, op_id), op, NULL); + op_id++; + return op_id-1; } static MPI_Op get_op(int op) { + char key[KEY_SIZE]; return op >= 0 - ? *(MPI_Op*)xbt_dynar_get_ptr(op_lookup, op) + ? (MPI_Op)xbt_dict_get_or_null(op_lookup, get_key(key, op)) : MPI_OP_NULL; } static void free_op(int op) { - xbt_dynar_remove_at(op_lookup, op, NULL); + char key[KEY_SIZE]; + xbt_dict_remove(op_lookup, get_key(key, op)); } void mpi_init_(int* ierr) { if(!comm_lookup){ - comm_lookup = xbt_dynar_new(sizeof(MPI_Comm), NULL); + comm_lookup = xbt_dict_new_homogeneous(NULL); new_comm(MPI_COMM_WORLD); - group_lookup = xbt_dynar_new(sizeof(MPI_Group), NULL); + group_lookup = xbt_dict_new_homogeneous(NULL); request_lookup = xbt_dict_new_homogeneous(NULL); - datatype_lookup = xbt_dynar_new(sizeof(MPI_Datatype), NULL); + datatype_lookup = xbt_dict_new_homogeneous(NULL); new_datatype(MPI_BYTE); new_datatype(MPI_CHAR); new_datatype(MPI_INT); @@ -141,9 +196,15 @@ void mpi_init_(int* ierr) { new_datatype(MPI_UINT64_T); new_datatype(MPI_2FLOAT); new_datatype(MPI_2DOUBLE); - - - op_lookup = xbt_dynar_new(sizeof(MPI_Op), NULL); + new_datatype(MPI_DOUBLE); + new_datatype(MPI_DOUBLE); + new_datatype(MPI_INT); + new_datatype(MPI_DATATYPE_NULL); + new_datatype(MPI_DATATYPE_NULL); + new_datatype(MPI_DATATYPE_NULL); + new_datatype(MPI_DATATYPE_NULL); + op_lookup = xbt_dict_new_homogeneous(NULL); + new_op(MPI_MAX); new_op(MPI_MIN); new_op(MPI_MAXLOC); new_op(MPI_MINLOC); @@ -158,18 +219,19 @@ void mpi_init_(int* ierr) { } /* smpif2c is responsible for generating a call with the final arguments */ *ierr = MPI_Init(NULL, NULL); + running_processes++; } void mpi_finalize_(int* ierr) { *ierr = MPI_Finalize(); - xbt_dynar_free(&op_lookup); - op_lookup = NULL; - xbt_dynar_free(&datatype_lookup); - datatype_lookup = NULL; - xbt_dict_free(&request_lookup); - request_lookup = NULL; - xbt_dynar_free(&comm_lookup); - comm_lookup = NULL; + running_processes--; + if(running_processes==0){ + xbt_dict_free(&op_lookup); + xbt_dict_free(&datatype_lookup); + xbt_dict_free(&request_lookup); + xbt_dict_free(&group_lookup); + xbt_dict_free(&comm_lookup); + } } void mpi_abort_(int* comm, int* errorcode, int* ierr) { @@ -267,7 +329,7 @@ void mpi_send_init_(void *buf, int* count, int* datatype, int* dst, int* tag, void mpi_isend_(void *buf, int* count, int* datatype, int* dst, int* tag, int* comm, int* request, int* ierr) { MPI_Request req; - + buf = (char *) F2C_BOTTOM(buf); *ierr = MPI_Isend(buf, *count, get_datatype(*datatype), *dst, *tag, get_comm(*comm), &req); if(*ierr == MPI_SUCCESS) { @@ -278,7 +340,7 @@ void mpi_isend_(void *buf, int* count, int* datatype, int* dst, void mpi_irsend_(void *buf, int* count, int* datatype, int* dst, int* tag, int* comm, int* request, int* ierr) { MPI_Request req; - + buf = (char *) F2C_BOTTOM(buf); *ierr = MPI_Irsend(buf, *count, get_datatype(*datatype), *dst, *tag, get_comm(*comm), &req); if(*ierr == MPI_SUCCESS) { @@ -304,7 +366,7 @@ void mpi_sendrecv_(void* sendbuf, int* sendcount, int* sendtype, int* dst, int* comm, MPI_Status* status, int* ierr) { *ierr = MPI_Sendrecv(sendbuf, *sendcount, get_datatype(*sendtype), *dst, *sendtag, recvbuf, *recvcount,get_datatype(*recvtype), *src, *recvtag, - get_comm(*comm), status); + get_comm(*comm), F2C_STATUS_IGNORE(status)); } void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag, @@ -321,7 +383,7 @@ void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag, void mpi_irecv_(void *buf, int* count, int* datatype, int* src, int* tag, int* comm, int* request, int* ierr) { MPI_Request req; - + buf = (char *) F2C_BOTTOM(buf); *ierr = MPI_Irecv(buf, *count, get_datatype(*datatype), *src, *tag, get_comm(*comm), &req); if(*ierr == MPI_SUCCESS) { @@ -356,7 +418,11 @@ void mpi_startall_(int* count, int* requests, int* ierr) { void mpi_wait_(int* request, MPI_Status* status, int* ierr) { MPI_Request req = find_request(*request); - *ierr = MPI_Wait(&req, status); + *ierr = MPI_Wait(&req, F2C_STATUS_IGNORE(status)); + if(req==MPI_REQUEST_NULL){ + free_request(*request); + *request=MPI_FORTRAN_REQUEST_NULL; + } } void mpi_waitany_(int* count, int* requests, int* index, MPI_Status* status, int* ierr) { @@ -368,6 +434,10 @@ void mpi_waitany_(int* count, int* requests, int* index, MPI_Status* status, int reqs[i] = find_request(requests[i]); } *ierr = MPI_Waitany(*count, reqs, index, status); + if(reqs[*index]==MPI_REQUEST_NULL){ + free_request(requests[*index]); + requests[*index]=MPI_FORTRAN_REQUEST_NULL; + } free(reqs); } @@ -379,7 +449,14 @@ void mpi_waitall_(int* count, int* requests, MPI_Status* status, int* ierr) { for(i = 0; i < *count; i++) { reqs[i] = find_request(requests[i]); } - *ierr = MPI_Waitall(*count, reqs, status); + *ierr = MPI_Waitall(*count, reqs, F2C_STATUSES_IGNORE(status)); + for(i = 0; i < *count; i++) { + if(reqs[i]==MPI_REQUEST_NULL){ + free_request(requests[i]); + requests[i]=MPI_FORTRAN_REQUEST_NULL; + } + } + free(reqs); } @@ -393,18 +470,23 @@ void mpi_bcast_(void *buf, int* count, int* datatype, int* root, int* comm, int* void mpi_reduce_(void* sendbuf, void* recvbuf, int* count, int* datatype, int* op, int* root, int* comm, int* ierr) { + sendbuf = (char *) F2C_IN_PLACE(sendbuf); + sendbuf = (char *) F2C_BOTTOM(sendbuf); + recvbuf = (char *) F2C_BOTTOM(recvbuf); *ierr = MPI_Reduce(sendbuf, recvbuf, *count, get_datatype(*datatype), get_op(*op), *root, get_comm(*comm)); } void mpi_allreduce_(void* sendbuf, void* recvbuf, int* count, int* datatype, int* op, int* comm, int* ierr) { + sendbuf = (char *) F2C_IN_PLACE(sendbuf); *ierr = MPI_Allreduce(sendbuf, recvbuf, *count, get_datatype(*datatype), get_op(*op), get_comm(*comm)); } void mpi_reduce_scatter_(void* sendbuf, void* recvbuf, int* recvcounts, int* datatype, int* op, int* comm, int* ierr) { + sendbuf = (char *) F2C_IN_PLACE(sendbuf); *ierr = MPI_Reduce_scatter(sendbuf, recvbuf, recvcounts, get_datatype(*datatype), get_op(*op), get_comm(*comm)); } @@ -412,6 +494,7 @@ void mpi_reduce_scatter_(void* sendbuf, void* recvbuf, int* recvcounts, int* dat void mpi_scatter_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, int* recvcount, int* recvtype, int* root, int* comm, int* ierr) { + recvbuf = (char *) F2C_IN_PLACE(recvbuf); *ierr = MPI_Scatter(sendbuf, *sendcount, get_datatype(*sendtype), recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm)); } @@ -420,6 +503,7 @@ void mpi_scatter_(void* sendbuf, int* sendcount, int* sendtype, void mpi_scatterv_(void* sendbuf, int* sendcounts, int* displs, int* sendtype, void* recvbuf, int* recvcount, int* recvtype, int* root, int* comm, int* ierr) { + recvbuf = (char *) F2C_IN_PLACE(recvbuf); *ierr = MPI_Scatterv(sendbuf, sendcounts, displs, get_datatype(*sendtype), recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm)); } @@ -427,6 +511,9 @@ 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 = (char *) F2C_IN_PLACE(sendbuf); + sendbuf = (char *) F2C_BOTTOM(sendbuf); + recvbuf = (char *) F2C_BOTTOM(recvbuf); *ierr = MPI_Gather(sendbuf, *sendcount, get_datatype(*sendtype), recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm)); } @@ -434,6 +521,9 @@ void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype, void mpi_gatherv_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, int* recvcounts, int* displs, int* recvtype, int* root, int* comm, int* ierr) { + sendbuf = (char *) F2C_IN_PLACE(sendbuf); + sendbuf = (char *) F2C_BOTTOM(sendbuf); + recvbuf = (char *) F2C_BOTTOM(recvbuf); *ierr = MPI_Gatherv(sendbuf, *sendcount, get_datatype(*sendtype), recvbuf, recvcounts, displs, get_datatype(*recvtype), *root, get_comm(*comm)); } @@ -441,6 +531,7 @@ void mpi_gatherv_(void* sendbuf, int* sendcount, int* sendtype, void mpi_allgather_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, int* recvcount, int* recvtype, int* comm, int* ierr) { + sendbuf = (char *) F2C_IN_PLACE(sendbuf); *ierr = MPI_Allgather(sendbuf, *sendcount, get_datatype(*sendtype), recvbuf, *recvcount, get_datatype(*recvtype), get_comm(*comm)); } @@ -448,6 +539,7 @@ void mpi_allgather_(void* sendbuf, int* sendcount, int* sendtype, void mpi_allgatherv_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, int* recvcounts,int* displs, int* recvtype, int* comm, int* ierr) { + sendbuf = (char *) F2C_IN_PLACE(sendbuf); *ierr = MPI_Allgatherv(sendbuf, *sendcount, get_datatype(*sendtype), recvbuf, recvcounts, displs, get_datatype(*recvtype), get_comm(*comm)); } @@ -472,7 +564,11 @@ void mpi_alltoallv_(void* sendbuf, int* sendcounts, int* senddisps, int* sendtyp void mpi_test_ (int * request, int *flag, MPI_Status * status, int* ierr){ MPI_Request req = find_request(*request); - *ierr= MPI_Test(&req, flag, status); + *ierr= MPI_Test(&req, flag, F2C_STATUS_IGNORE(status)); + if(req==MPI_REQUEST_NULL){ + free_request(*request); + *request=MPI_FORTRAN_REQUEST_NULL; + } } @@ -483,7 +579,13 @@ void mpi_testall_ (int* count, int * requests, int *flag, MPI_Status * statuses for(i = 0; i < *count; i++) { reqs[i] = find_request(requests[i]); } - *ierr= MPI_Testall(*count, reqs, flag, statuses); + *ierr= MPI_Testall(*count, reqs, flag, F2C_STATUSES_IGNORE(statuses)); + for(i = 0; i < *count; i++) { + if(reqs[i]==MPI_REQUEST_NULL){ + free_request(requests[i]); + requests[i]=MPI_FORTRAN_REQUEST_NULL; + } + } } @@ -492,7 +594,7 @@ void mpi_get_processor_name_(char *name, int *resultlen, int* ierr){ } void mpi_get_count_(MPI_Status * status, int* datatype, int *count, int* ierr){ - *ierr = MPI_Get_count(status, get_datatype(*datatype), count); + *ierr = MPI_Get_count(F2C_STATUS_IGNORE(status), get_datatype(*datatype), count); } void mpi_attr_get_(int* comm, int* keyval, void* attr_value, int* flag, int* ierr ){ @@ -604,13 +706,13 @@ void mpi_finalized_ (int * flag, int* ierr){ void mpi_init_thread_ (int* required, int *provided, int* ierr){ if(!comm_lookup){ - comm_lookup = xbt_dynar_new(sizeof(MPI_Comm), NULL); + comm_lookup = xbt_dict_new_homogeneous(NULL); new_comm(MPI_COMM_WORLD); - group_lookup = xbt_dynar_new(sizeof(MPI_Group), NULL); + group_lookup = xbt_dict_new_homogeneous(NULL); request_lookup = xbt_dict_new_homogeneous(NULL); - datatype_lookup = xbt_dynar_new(sizeof(MPI_Datatype), NULL); + datatype_lookup = xbt_dict_new_homogeneous(NULL); new_datatype(MPI_BYTE); new_datatype(MPI_CHAR); new_datatype(MPI_INT); @@ -633,8 +735,7 @@ void mpi_init_thread_ (int* required, int *provided, int* ierr){ new_datatype(MPI_2FLOAT); new_datatype(MPI_2DOUBLE); - - op_lookup = xbt_dynar_new(sizeof(MPI_Op), NULL); + op_lookup = xbt_dict_new_homogeneous( NULL); new_op(MPI_MAX); new_op(MPI_MIN); new_op(MPI_MAXLOC); @@ -878,7 +979,7 @@ void mpi_sendrecv_replace_ (void *buf, int* count, int* datatype, int* dst, int* { *ierr = MPI_Sendrecv_replace(buf, *count, get_datatype(*datatype), *dst, *sendtag, *src, - *recvtag, get_comm(*comm), status); + *recvtag, get_comm(*comm), F2C_STATUS_IGNORE(status)); } void mpi_testany_ (int* count, int* requests, int *index, int *flag, MPI_Status* status, int* ierr) @@ -890,9 +991,13 @@ void mpi_testany_ (int* count, int* requests, int *index, int *flag, MPI_Status* for(i = 0; i < *count; i++) { reqs[i] = find_request(requests[i]); } - *ierr = MPI_Testany(*count, reqs, index, flag, status); + *ierr = MPI_Testany(*count, reqs, index, flag, F2C_STATUS_IGNORE(status)); + if(*index!=MPI_UNDEFINED) + if(reqs[*index]==MPI_REQUEST_NULL){ + free_request(requests[*index]); + requests[*index]=MPI_FORTRAN_REQUEST_NULL; + } free(reqs); - } void mpi_waitsome_ (int* incount, int* requests, int *outcount, int *indices, MPI_Status* status, int* ierr) @@ -905,8 +1010,13 @@ void mpi_waitsome_ (int* incount, int* requests, int *outcount, int *indices, MP reqs[i] = find_request(requests[i]); } *ierr = MPI_Waitsome(*incount, reqs, outcount, indices, status); + for(i=0;i<*outcount;i++){ + if(reqs[indices[i]]==MPI_REQUEST_NULL){ + free_request(requests[indices[i]]); + requests[indices[i]]=MPI_FORTRAN_REQUEST_NULL; + } + } free(reqs); - } void mpi_reduce_local_ (void *inbuf, void *inoutbuf, int* count, int* datatype, int* op, int* ierr){ @@ -916,7 +1026,7 @@ void mpi_reduce_local_ (void *inbuf, void *inoutbuf, int* count, int* datatype, void mpi_reduce_scatter_block_ (void *sendbuf, void *recvbuf, int* recvcount, int* datatype, int* op, int* comm, int* ierr) { - + sendbuf = (char *) F2C_IN_PLACE(sendbuf); *ierr = MPI_Reduce_scatter_block(sendbuf, recvbuf, *recvcount, get_datatype(*datatype), get_op(*op), get_comm(*comm)); } @@ -1020,6 +1130,10 @@ void mpi_comm_set_errhandler_ (int* comm, void* errhandler, int* ierr) { *ierr = MPI_Errhandler_set(get_comm(*comm), *(MPI_Errhandler*)errhandler); } +void mpi_comm_get_errhandler_ (int* comm, void* errhandler, int* ierr) { + *ierr = MPI_Errhandler_set(get_comm(*comm), (MPI_Errhandler*)errhandler); +} + void mpi_type_contiguous_ (int* count, int* old_type, int* newtype, int* ierr) { MPI_Datatype tmp; *ierr = MPI_Type_contiguous(*count, get_datatype(*old_type), &tmp); @@ -1045,7 +1159,24 @@ void mpi_buffer_detach_ (void* buffer, int* size, int* ierr) { } void mpi_testsome_ (int* incount, int* requests, int* outcount, int* indices, MPI_Status* statuses, int* ierr) { - *ierr = MPI_Testsome(*incount, (MPI_Request*)requests, outcount, indices, statuses); + MPI_Request* reqs; + int i; + + reqs = xbt_new(MPI_Request, *incount); + for(i = 0; i < *incount; i++) { + reqs[i] = find_request(requests[i]); + indices[i]=0; + } + *ierr = MPI_Testsome(*incount, reqs, outcount, indices, F2C_STATUSES_IGNORE(statuses)); + for(i=0;i<*incount;i++){ + if(indices[i]){ + if(reqs[indices[i]]==MPI_REQUEST_NULL){ + free_request(requests[indices[i]]); + requests[indices[i]]=MPI_FORTRAN_REQUEST_NULL; + } + } + } + free(reqs); } void mpi_comm_test_inter_ (int* comm, int* flag, int* ierr) { @@ -1193,7 +1324,7 @@ void mpi_issend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int } void mpi_probe_ (int* source, int* tag, int* comm, MPI_Status* status, int* ierr) { - *ierr = MPI_Probe(*source, *tag, get_comm(*comm), status); + *ierr = MPI_Probe(*source, *tag, get_comm(*comm), F2C_STATUS_IGNORE(status)); } void mpi_attr_delete_ (int* comm, int* keyval, int* ierr) {