fortran/mpif-h: fix MPI_[I]Alltoallw() binding

 - ignore sendcounts, sendispls and sendtypes arguments when MPI_IN_PLACE is used
 - use the right size when an inter-communicator is used.

Thanks Markus Geimer for reporting this.

Refs. #5459

Signed-off-by: Gilles Gouaillardet <[email protected]>

Author: ggouaillardet

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

@@ -10,7 +10,7 @@
  * 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
+ * Copyright (c) 2015-2019 Research Organization for Information Science
  *                         and Technology (RIST). All rights reserved.
  * $COPYRIGHT$
  *
@@ -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
@@ -82,20 +83,22 @@ void ompi_alltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
     OMPI_ARRAY_NAME_DECL(rdispls);
 
     c_comm = PMPI_Comm_f2c(*comm);
-    PMPI_Comm_size(c_comm, &size);
+    size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm);
 
-    c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
-    c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
+    if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
+        c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
+        OMPI_ARRAY_FINT_2_INT(sendcounts, size);
+        OMPI_ARRAY_FINT_2_INT(sdispls, size);
+        for (int i=0; i<size; i++) {
+            c_sendtypes[i] = PMPI_Type_f2c(sendtypes[i]);
+        }
+    }
 
-    OMPI_ARRAY_FINT_2_INT(sendcounts, size);
-    OMPI_ARRAY_FINT_2_INT(sdispls, size);
+    c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
     OMPI_ARRAY_FINT_2_INT(recvcounts, size);
     OMPI_ARRAY_FINT_2_INT(rdispls, size);
-
-    while (size > 0) {
-        c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]);
-        c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]);
-        --size;
+    for (int i=0; i<size; i++) {
+        c_recvtypes[i] = PMPI_Type_f2c(recvtypes[i]);
     }
 
     sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
@@ -116,6 +119,8 @@ void ompi_alltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
     OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls);
     OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
     OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
-    free(c_sendtypes);
+    if (MPI_IN_PLACE != sendbuf) {
+        free(c_sendtypes);
+    }
     free(c_recvtypes);
 }

ompi/mpi/fortran/mpif-h/ialltoallw_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
@@ -83,21 +84,24 @@ void ompi_ialltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
     OMPI_ARRAY_NAME_DECL(rdispls);
 
     c_comm = PMPI_Comm_f2c(*comm);
-    PMPI_Comm_size(c_comm, &size);
+    size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm);
 
-    c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
-    c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
+    if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
+        c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
+        OMPI_ARRAY_FINT_2_INT(sendcounts, size);
+        OMPI_ARRAY_FINT_2_INT(sdispls, size);
+        for (int i=0; i<size; i++) {
+            c_sendtypes[i] = PMPI_Type_f2c(sendtypes[i]);
+        }
+    }
 
-    OMPI_ARRAY_FINT_2_INT(sendcounts, size);
-    OMPI_ARRAY_FINT_2_INT(sdispls, size);
+    c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
     OMPI_ARRAY_FINT_2_INT(recvcounts, size);
     OMPI_ARRAY_FINT_2_INT(rdispls, size);
-
-    while (size > 0) {
-        c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]);
-        c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]);
-        --size;
+    for (int i=0; i<size; i++) {
+        c_recvtypes[i] = PMPI_Type_f2c(recvtypes[i]);
     }
+    c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
 
     sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
     sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
@@ -118,6 +122,8 @@ void ompi_ialltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
     OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls);
     OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
     OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
-    free(c_sendtypes);
+    if (MPI_IN_PLACE != sendbuf) {
+        free(c_sendtypes);
+    }
     free(c_recvtypes);
 }