ajout de la fonction MPI_Ireduce pour l'interposition Fortran

Author: wailbald

src/interpolf.c

@@ -859,4 +859,98 @@ _EXTERN_C_ void mpi_iscatter_(MPI_Fint *sendbuf, MPI_Fint *sendcount, MPI_Fint *
 
 _EXTERN_C_ void mpi_iscatter__(MPI_Fint *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype, MPI_Fint *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) { 
     MPI_Iscatter_fortran_wrapper(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm, request, ierr);
+}
+
+
+static void MPI_Ireduce_fortran_wrapper(MPI_Fint *sendbuf, MPI_Fint *recvbuf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) { 
+    int _wrap_py_return_val = 0;
+
+    Tsc const tsc = rdtsc();
+
+    #if (!defined(MPICH_HAS_C2F) && defined(MPICH_NAME) && (MPICH_NAME == 1)) /* MPICH test */
+        _wrap_py_return_val = PMPI_Ireduce((const void*)sendbuf, (void*)recvbuf, *count, (MPI_Datatype)(*datatype), (MPI_Op)(*op), *root, (MPI_Comm)(*comm), (MPI_Request*)request);
+    #else /* MPI-2 safe call */
+        MPI_Request temp_request;
+        temp_request = MPI_Request_f2c(*request);
+        _wrap_py_return_val = PMPI_Ireduce((const void*)sendbuf, (void*)recvbuf, *count, MPI_Type_f2c(*datatype), MPI_Op_f2c(*op), *root, MPI_Comm_f2c(*comm), &temp_request);
+        *request = MPI_Request_c2f(temp_request);
+    #endif /* MPICH test */
+
+    Tsc const duration = rdtsc() - tsc;
+
+    int nb_bytes;
+    PMPI_Type_size(MPI_Type_f2c(*datatype), &nb_bytes);
+
+    MpiOp op_type;
+    if ((MPI_Op)op == MPI_MAX) {
+        op_type = Max;
+    } else if ((MPI_Op)op == MPI_MIN) {
+        op_type = Min;
+    } else if ((MPI_Op)op == MPI_SUM) {
+        op_type = Sum;
+    } else if ((MPI_Op)op == MPI_PROD) {
+        op_type = Prod;
+    } else if ((MPI_Op)op == MPI_LAND) {
+        op_type = Land;
+    } else if ((MPI_Op)op == MPI_BAND) {
+        op_type = Band;
+    } else if ((MPI_Op)op == MPI_LOR) {
+        op_type = Lor;
+    } else if ((MPI_Op)op == MPI_BOR) {
+        op_type = Bor;
+    } else if ((MPI_Op)op == MPI_LXOR) {
+        op_type = Lxor;
+    } else if ((MPI_Op)op == MPI_BXOR) {
+        op_type = Bxor;
+    } else if ((MPI_Op)op == MPI_MAXLOC) {
+        op_type = Maxloc;
+    } else if ((MPI_Op)op == MPI_MINLOC) {
+        op_type = Minloc;
+    } else if ((MPI_Op)op == MPI_REPLACE) {
+        op_type = Replace;
+    } else if ((MPI_Op)op == MPI_OP_NULL) {
+        op_type = Opnull;
+    } else if ((MPI_Op)op == MPI_NO_OP) {
+        op_type = Opnull;
+    } else {
+        op_type = -1;
+    }
+
+    MpiCall const ireduce = {
+        .kind = Ireduce,
+        .time = -1.0,
+        .tsc = tsc,
+        .duration = duration,
+        .current_rank = current_rank,
+        .partner_rank = *root,
+        .nb_bytes_s = nb_bytes,
+        .nb_bytes_r = nb_bytes * (*count),
+        .comm = PMPI_Comm_c2f((MPI_Comm)comm),
+        .req = *request,
+        .tag = -1,
+        .required_thread_lvl = -1,
+        .provided_thread_lvl = -1,
+        .op_type = op_type,
+        .finished = false,
+    };
+
+    register_mpi_call(ireduce);
+
+    *ierr = _wrap_py_return_val;
+}
+
+_EXTERN_C_ void MPI_IREDUCE(MPI_Fint *sendbuf, MPI_Fint *recvbuf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) { 
+    MPI_Ireduce_fortran_wrapper(sendbuf, recvbuf, count, datatype, op, root, comm, request, ierr);
+}
+
+_EXTERN_C_ void mpi_ireduce(MPI_Fint *sendbuf, MPI_Fint *recvbuf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) { 
+    MPI_Ireduce_fortran_wrapper(sendbuf, recvbuf, count, datatype, op, root, comm, request, ierr);
+}
+
+_EXTERN_C_ void mpi_ireduce_(MPI_Fint *sendbuf, MPI_Fint *recvbuf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) { 
+    MPI_Ireduce_fortran_wrapper(sendbuf, recvbuf, count, datatype, op, root, comm, request, ierr);
+}
+
+_EXTERN_C_ void mpi_ireduce__(MPI_Fint *sendbuf, MPI_Fint *recvbuf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) { 
+    MPI_Ireduce_fortran_wrapper(sendbuf, recvbuf, count, datatype, op, root, comm, request, ierr);
 }