From: degomme <augustin.degomme@unibas.ch>
Date: Mon, 13 Feb 2017 17:09:52 +0000 (+0100)
Subject: Add support in fortran for user added MPI operations
X-Git-Tag: v3_15~400
X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/commitdiff_plain/74c01bac7c42149bd7badf0a1897d936dab3c858

Add support in fortran for user added MPI operations
---

diff --git a/src/smpi/smpi_f77.cpp b/src/smpi/smpi_f77.cpp
index 6eb35b13a9..4deac65fbf 100644
--- a/src/smpi/smpi_f77.cpp
+++ b/src/smpi/smpi_f77.cpp
@@ -937,6 +937,7 @@ void mpi_op_create_ (void * function, int* commute, int* op, int* ierr){
   MPI_Op tmp;
  *ierr = MPI_Op_create(reinterpret_cast<MPI_User_function*>(function),*commute, &tmp);
  if(*ierr == MPI_SUCCESS) {
+   smpi_op_set_fortran(tmp);
    *op = smpi_op_c2f(tmp);
  }
 }
diff --git a/src/smpi/smpi_mpi_dt.cpp b/src/smpi/smpi_mpi_dt.cpp
index f7d69c5c15..619a2d8f31 100644
--- a/src/smpi/smpi_mpi_dt.cpp
+++ b/src/smpi/smpi_mpi_dt.cpp
@@ -1160,6 +1160,7 @@ void smpi_datatype_commit(MPI_Datatype *datatype)
 typedef struct s_smpi_mpi_op {
   MPI_User_function *func;
   bool is_commute;
+  bool is_fortran_op;
 } s_smpi_mpi_op_t;
 
 #define MAX_OP(a, b)  (b) = (a) < (b) ? (b) : (a)
@@ -1344,7 +1345,7 @@ static void replace_func(void *a, void *b, int *length, MPI_Datatype * datatype)
 }
 
 #define CREATE_MPI_OP(name, func)                             \
-  static s_smpi_mpi_op_t mpi_##name = { &(func) /* func */, true }; \
+  static s_smpi_mpi_op_t mpi_##name = { &(func) /* func */, true, false }; \
 MPI_Op name = &mpi_##name;
 
 CREATE_MPI_OP(MPI_MAX, max_func);
@@ -1367,6 +1368,7 @@ MPI_Op smpi_op_new(MPI_User_function * function, bool commute)
   op = xbt_new(s_smpi_mpi_op_t, 1);
   op->func = function;
   op-> is_commute = commute;
+  op-> is_fortran_op = false;
   return op;
 }
 
@@ -1380,6 +1382,12 @@ void smpi_op_destroy(MPI_Op op)
   xbt_free(op);
 }
 
+void smpi_op_set_fortran(MPI_Op op)
+{
+  //tell that we were created from fortran, so we need to translate the type to fortran when called
+  op->is_fortran_op = true;
+}
+
 void smpi_op_apply(MPI_Op op, const void *invec, void *inoutvec, int *len, MPI_Datatype * datatype)
 {
   if(op==MPI_OP_NULL)
@@ -1390,8 +1398,14 @@ void smpi_op_apply(MPI_Op op, const void *invec, void *inoutvec, int *len, MPI_D
     smpi_switch_data_segment(smpi_process_index());
   }
 
-  if(!smpi_process_get_replaying())
-    op->func(const_cast<void*>(invec), inoutvec, len, datatype);
+  if(!smpi_process_get_replaying()){
+    if(! op->is_fortran_op)
+      op->func(const_cast<void*>(invec), inoutvec, len, datatype);
+    else{
+      int tmp = smpi_type_c2f(*datatype);
+      op->func(const_cast<void*>(invec), inoutvec, len, reinterpret_cast<MPI_Datatype*>(&tmp) );
+    }
+  }
 }
 
 int smpi_type_attr_delete(MPI_Datatype type, int keyval){