Support for Fortran code in SMPI based on f2c, some perl and some dirty hacks.

[simgrid.git] / src / smpi / smpi_mpi.c

diff --git a/src/smpi/smpi_mpi.c b/src/smpi/smpi_mpi.c
index 0f08ff8..ff15e6a 100644 (file)
--- a/src/smpi/smpi_mpi.c
+++ b/src/smpi/smpi_mpi.c
@@ -11,6 +11,31 @@
 XBT_LOG_NEW_DEFAULT_SUBCATEGORY(smpi_mpi, smpi,
                                 "Logging specific to SMPI (mpi)");
 
+#ifdef HAVE_TRACING
+//this function need to be here because of the calls to smpi_bench
+int TRACE_smpi_set_category(const char *category)
+{
+  //need to end bench otherwise categories for execution tasks are wrong
+  smpi_bench_end (-1, NULL);
+  int ret;
+  if (!IS_TRACING){
+    ret = 1;
+  }else{
+    if (category != NULL) {
+      ret = TRACE_category(category);
+      TRACE_category_set(SIMIX_process_self(), category);
+    }else{
+      //if category is NULL, trace of platform is disabled for this process
+      TRACE_category_unset(SIMIX_process_self());
+      ret = 0;
+    }
+  }
+  //begin bench after changing process's category
+  smpi_bench_begin (-1, NULL);
+  return ret;
+}
+#endif
+
 /* MPI User level calls */
 
 int MPI_Init(int *argc, char ***argv)
@@ -737,6 +762,24 @@ int MPI_Comm_free(MPI_Comm * comm)
   return retval;
 }
 
+int MPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm* comm_out)
+{
+  int retval;
+
+  smpi_bench_end(-1, NULL);
+  if (comm_out == NULL) {
+    retval = MPI_ERR_ARG;
+  } else if (comm == MPI_COMM_NULL) {
+    retval = MPI_ERR_COMM;
+  } else {
+    printf("[%d] gives %d, %d\n", smpi_comm_rank(comm), color, key);
+    *comm_out = smpi_comm_split(comm, color, key);
+    retval = MPI_SUCCESS;
+  }
+  smpi_bench_begin(-1, NULL);
+  return retval;
+}
+
 int MPI_Send_init(void *buf, int count, MPI_Datatype datatype, int dst,
                   int tag, MPI_Comm comm, MPI_Request * request)
 {
@@ -1085,14 +1128,7 @@ int MPI_Waitany(int count, MPI_Request requests[], int *index,
       xbt_dynar_insert_at(recvs, i, t);
     }
   }
-
-  //search for a suitable request to give the rank of current mpi proc
-  MPI_Request req = NULL;
-  for (i = 0; i < count && req == NULL; i++) {
-    req = requests[i];
-  }
-  MPI_Comm comm = (req)->comm;
-  int rank_traced = smpi_comm_rank(comm);
+  int rank_traced = smpi_comm_rank(MPI_COMM_WORLD);
   TRACE_smpi_ptp_in(rank_traced, -1, -1, __FUNCTION__);
 #endif
   if (index == NULL) {
@@ -1141,14 +1177,7 @@ int MPI_Waitall(int count, MPI_Request requests[], MPI_Status status[])
     xbt_dynar_insert_at(dsts, i, adst);
     xbt_dynar_insert_at(recvs, i, arecv);
   }
-
-//  find my rank inside one of MPI_Comm's of the requests
-  MPI_Request req = NULL;
-  for (i = 0; i < count && req == NULL; i++) {
-    req = requests[i];
-  }
-  MPI_Comm comm = (req)->comm;
-  int rank_traced = smpi_comm_rank(comm);
+  int rank_traced = smpi_comm_rank (MPI_COMM_WORLD);
   TRACE_smpi_ptp_in(rank_traced, -1, -1, __FUNCTION__);
 #endif
   smpi_mpi_waitall(count, requests, status);