checkpoint

Author: ggouaillardet

ompi/mca/coll/libnbc/nbc_ialltoall.c

@@ -77,39 +77,40 @@ static int nbc_alltoall_init(const void* sendbuf, int sendcount, MPI_Datatype se
   rank = ompi_comm_rank (comm);
   p = ompi_comm_size (comm);
 
-  res = ompi_datatype_type_extent(sendtype, &sndext);
-  if (MPI_SUCCESS != res) {
-    NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
-    return res;
-  }
-
   res = ompi_datatype_type_extent(recvtype, &rcvext);
   if (MPI_SUCCESS != res) {
     NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
     return res;
   }
 
-  res = ompi_datatype_type_size(sendtype, &sndsize);
-  if (MPI_SUCCESS != res) {
-    NBC_Error("MPI Error in ompi_datatype_type_size() (%i)", res);
-    return res;
-  }
-
-  /* algorithm selection */
-  a2asize = sndsize * sendcount * p;
-  /* this number is optimized for TCP on odin.cs.indiana.edu */
   if (inplace) {
     alg = NBC_A2A_INPLACE;
-  } else if((p <= 8) && ((a2asize < 1<<17) || (sndsize*sendcount < 1<<12))) {
-    /* just send as fast as we can if we have less than 8 peers, if the
-     * total communicated size is smaller than 1<<17 *and* if we don't
-     * have eager messages (msgsize < 1<<13) */
-    alg = NBC_A2A_LINEAR;
-  } else if(a2asize < (1<<12)*(unsigned int)p) {
-    /*alg = NBC_A2A_DISS;*/
-    alg = NBC_A2A_LINEAR;
-  } else
-    alg = NBC_A2A_LINEAR; /*NBC_A2A_PAIRWISE;*/
+  } else {
+    /* algorithm selection */
+    res = ompi_datatype_type_extent(sendtype, &sndext);
+    if (MPI_SUCCESS != res) {
+      NBC_Error("MPI Error in ompi_datatype_type_extent() (%i)", res);
+      return res;
+    }
+    res = ompi_datatype_type_size(sendtype, &sndsize);
+    if (MPI_SUCCESS != res) {
+      NBC_Error("MPI Error in ompi_datatype_type_size() (%i)", res);
+      return res;
+    }
+
+    a2asize = sndsize * sendcount * p;
+    /* this number is optimized for TCP on odin.cs.indiana.edu */
+    if((p <= 8) && ((a2asize < 1<<17) || (sndsize*sendcount < 1<<12))) {
+      /* just send as fast as we can if we have less than 8 peers, if the
+       * total communicated size is smaller than 1<<17 *and* if we don't
+       * have eager messages (msgsize < 1<<13) */
+      alg = NBC_A2A_LINEAR;
+    } else if(a2asize < (1<<12)*(unsigned int)p) {
+      /*alg = NBC_A2A_DISS;*/
+      alg = NBC_A2A_LINEAR;
+    } else
+      alg = NBC_A2A_LINEAR; /*NBC_A2A_PAIRWISE;*/
+  }
 
   /* allocate temp buffer if we need one */
   if (alg == NBC_A2A_INPLACE) {

ompi/mpi/c/bcast.c

@@ -76,12 +76,14 @@ int MPI_Bcast(void *buffer, int count, MPI_Datatype datatype,
                                      FUNC_NAME);
       }
 
-      /* Errors for all ranks */
+      /* Errors for all involved ranks */
 
-      OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count);
-      OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME);
-      if (MPI_IN_PLACE == buffer) {
+      if (OMPI_COMM_IS_INTRA(comm) || MPI_PROC_NULL != root) {
+        OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count);
+        OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME);
+        if (MPI_IN_PLACE == buffer) {
           return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
+        }
       }
 
       /* Errors for intracommunicators */

ompi/mpi/c/ibcast.c

@@ -70,12 +70,14 @@ int MPI_Ibcast(void *buffer, int count, MPI_Datatype datatype,
                                      FUNC_NAME);
       }
 
-      /* Errors for all ranks */
+      /* Errors for all involved ranks */
 
-      OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count);
-      OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME);
-      if (MPI_IN_PLACE == buffer) {
+      if (OMPI_COMM_IS_INTRA(comm) || MPI_PROC_NULL != root) {
+        OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count);
+        OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME);
+        if (MPI_IN_PLACE == buffer) {
           return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME);
+        }
       }
 
       /* Errors for intracommunicators */

ompi/mpi/fortran/base/fint_2_int.h

@@ -47,9 +47,10 @@
   #define OMPI_SINGLE_FINT_2_INT(in)
   #define OMPI_SINGLE_INT_2_FINT(in)
   #define OMPI_ARRAY_INT_2_FINT(in, n)
+  #define OMPI_COND_STATEMENT(a)
 
 #elif OMPI_SIZEOF_FORTRAN_INTEGER > SIZEOF_INT
-  #define OMPI_ARRAY_NAME_DECL(a) int *c_##a
+  #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL
   #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) int (*c_##a)[dim2], dim2_index
   #define OMPI_SINGLE_NAME_DECL(a) int c_##a
   #define OMPI_ARRAY_NAME_CONVERT(a) c_##a
@@ -86,7 +87,8 @@
 
   /* This is for IN parameters. Does only free */
   #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) \
-    free(OMPI_ARRAY_NAME_CONVERT(in))
+    if (NULL != OMPI_ARRAY_NAME_CONVERT(in)) \
+      free(OMPI_ARRAY_NAME_CONVERT(in))
 
   /* This is for single IN parameter */
   #define OMPI_SINGLE_FINT_2_INT(in) \
@@ -105,8 +107,10 @@
       } \
       free(OMPI_ARRAY_NAME_CONVERT(in)); \
     } while (0)
+
+  #define OMPI_COND_STATEMENT(a) a
 #else /* int > MPI_Fint  */
-  #define OMPI_ARRAY_NAME_DECL(a) int *c_##a
+  #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL
   #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) int (*c_##a)[dim2], dim2_index
   #define OMPI_SINGLE_NAME_DECL(a) int c_##a
   #define OMPI_ARRAY_NAME_CONVERT(a) c_##a
@@ -140,7 +144,8 @@
     } while (0)
 
   #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) \
-    free(OMPI_ARRAY_NAME_CONVERT(in))
+    if (NULL != OMPI_ARRAY_NAME_CONVERT(in)) \
+      free(OMPI_ARRAY_NAME_CONVERT(in))
 
   #define OMPI_SINGLE_FINT_2_INT(in) \
      OMPI_ARRAY_NAME_CONVERT(in) = *(in)
@@ -157,6 +162,7 @@
       free(OMPI_ARRAY_NAME_CONVERT(in)); \
     } while (0)
 
+  #define OMPI_COND_STATEMENT(a) a
 #endif
 
 /*

ompi/mpi/fortran/mpif-h/allgather_f.c

@@ -10,8 +10,8 @@
  * Copyright (c) 2004-2005 The Regents of the University of California.
  *                         All rights reserved.
  * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
- * Copyright (c) 2015      Research Organization for Information Science
- *                         and Technology (RIST). All rights reserved.
+ * Copyright (c) 2015-2019 Research Organization for Information Science
+ *                         and Technology (RIST).  All rights reserved.
  * $COPYRIGHT$
  *
  * Additional copyrights may follow
@@ -23,6 +23,7 @@
 
 #include "ompi/mpi/fortran/mpif-h/bindings.h"
 #include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/communicator/communicator.h"
 
 #if OMPI_BUILD_MPI_PROFILING
 #if OPAL_HAVE_WEAK_SYMBOLS
@@ -72,19 +73,22 @@ void ompi_allgather_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
 		     MPI_Fint *comm, MPI_Fint *ierr)
 {
     int ierr_c;
-    MPI_Comm c_comm;
-    MPI_Datatype c_sendtype, c_recvtype;
+    MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
+    int c_sendcount = 0;
+    MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype);
 
-    c_comm = PMPI_Comm_f2c(*comm);
-    c_sendtype = PMPI_Type_f2c(*sendtype);
-    c_recvtype = PMPI_Type_f2c(*recvtype);
+    if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
+        c_sendtype = PMPI_Type_f2c(*sendtype);
+        c_sendcount = OMPI_FINT_2_INT(*sendcount);
+    } else {
+        sendbuf = MPI_IN_PLACE;
+    }
 
-    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
     sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
     recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
 
     ierr_c = PMPI_Allgather(sendbuf,
-                            OMPI_FINT_2_INT(*sendcount),
+                            c_sendcount,
                             c_sendtype,
                             recvbuf,
                             OMPI_FINT_2_INT(*recvcount),

ompi/mpi/fortran/mpif-h/allgatherv_f.c

@@ -10,8 +10,8 @@
  * Copyright (c) 2004-2005 The Regents of the University of California.
  *                         All rights reserved.
  * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
- * Copyright (c) 2015      Research Organization for Information Science
- *                         and Technology (RIST). All rights reserved.
+ * Copyright (c) 2015-2019 Research Organization for Information Science
+ *                         and Technology (RIST).  All rights reserved.
  * $COPYRIGHT$
  *
  * Additional copyrights may follow
@@ -23,6 +23,7 @@
 
 #include "ompi/mpi/fortran/mpif-h/bindings.h"
 #include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/communicator/communicator.h"
 
 #if OMPI_BUILD_MPI_PROFILING
 #if OPAL_HAVE_WEAK_SYMBOLS
@@ -71,26 +72,37 @@ void ompi_allgatherv_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
 		      char *recvbuf, MPI_Fint *recvcounts, MPI_Fint *displs,
 		      MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr)
 {
-    MPI_Comm c_comm;
-    MPI_Datatype c_sendtype, c_recvtype;
-    int size, ierr_c;
+    int ierr_c;
+    MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
+    int c_sendcount = 0;
+    MPI_Datatype c_sendtype = NULL, c_recvtype;
+    OMPI_COND_STATEMENT(int size);
     OMPI_ARRAY_NAME_DECL(recvcounts);
     OMPI_ARRAY_NAME_DECL(displs);
 
-    c_comm = PMPI_Comm_f2c(*comm);
-    c_sendtype = PMPI_Type_f2c(*sendtype);
+    if (OMPI_COMM_IS_INTER(c_comm)) {
+        OMPI_COND_STATEMENT(size = ompi_comm_remote_size(c_comm));
+        c_sendtype = PMPI_Type_f2c(*sendtype);
+        c_sendcount = OMPI_FINT_2_INT(*sendcount);
+    } else {
+        OMPI_COND_STATEMENT(size = ompi_comm_size(c_comm));
+        if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
+            sendbuf = MPI_IN_PLACE;
+        } else {
+            c_sendtype = PMPI_Type_f2c(*sendtype);
+            c_sendcount = OMPI_FINT_2_INT(*sendcount);
+        }
+    }
     c_recvtype = PMPI_Type_f2c(*recvtype);
 
-    PMPI_Comm_size(c_comm, &size);
     OMPI_ARRAY_FINT_2_INT(recvcounts, size);
     OMPI_ARRAY_FINT_2_INT(displs, size);
 
-    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
     sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
     recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
 
     ierr_c = PMPI_Allgatherv(sendbuf,
-                             OMPI_FINT_2_INT(*sendcount),
+                             c_sendcount,
                              c_sendtype,
                              recvbuf,
                              OMPI_ARRAY_NAME_CONVERT(recvcounts),

ompi/mpi/fortran/mpif-h/alltoall_f.c

@@ -10,8 +10,8 @@
  * Copyright (c) 2004-2005 The Regents of the University of California.
  *                         All rights reserved.
  * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
- * Copyright (c) 2015      Research Organization for Information Science
- *                         and Technology (RIST). All rights reserved.
+ * Copyright (c) 2015-2019 Research Organization for Information Science
+ *                         and Technology (RIST).  All rights reserved.
  * $COPYRIGHT$
  *
  * Additional copyrights may follow
@@ -23,6 +23,7 @@
 
 #include "ompi/mpi/fortran/mpif-h/bindings.h"
 #include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/communicator/communicator.h"
 
 #if OMPI_BUILD_MPI_PROFILING
 #if OPAL_HAVE_WEAK_SYMBOLS
@@ -72,22 +73,26 @@ void ompi_alltoall_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
 		    MPI_Fint *comm, MPI_Fint *ierr)
 {
     int c_ierr;
-    MPI_Comm c_comm;
-    MPI_Datatype c_sendtype, c_recvtype;
+    MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
+    int c_sendcount = 0;
+    MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype);
 
-    c_comm = PMPI_Comm_f2c(*comm);
-    c_sendtype = PMPI_Type_f2c(*sendtype);
-    c_recvtype = PMPI_Type_f2c(*recvtype);
+    if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
+        c_sendtype = PMPI_Type_f2c(*sendtype);
+        c_sendcount = OMPI_FINT_2_INT(*sendcount);
+    } else {
+        sendbuf = MPI_IN_PLACE;
+    }
 
-    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
     sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
     recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
 
     c_ierr = PMPI_Alltoall(sendbuf,
-                          OMPI_FINT_2_INT(*sendcount),
-                          c_sendtype,
-                          recvbuf,
-                          OMPI_FINT_2_INT(*recvcount),
-                          c_recvtype, c_comm);
+                           c_sendcount,
+                           c_sendtype,
+                           recvbuf,
+                           OMPI_FINT_2_INT(*recvcount),
+                           c_recvtype, c_comm);
+
     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 }