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. open-mpi/ompi#5459 Signed-off-by: Gilles Gouaillardet <gilles@rist.or.jp>
Этот коммит содержится в:
родитель
020a5918af
Коммит
cdaed89d04
@ -10,7 +10,7 @@
|
|||||||
* Copyright (c) 2004-2005 The Regents of the University of California.
|
* Copyright (c) 2004-2005 The Regents of the University of California.
|
||||||
* All rights reserved.
|
* All rights reserved.
|
||||||
* Copyright (c) 2011-2012 Cisco Systems, Inc. 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.
|
* and Technology (RIST). All rights reserved.
|
||||||
* $COPYRIGHT$
|
* $COPYRIGHT$
|
||||||
*
|
*
|
||||||
@ -23,6 +23,7 @@
|
|||||||
|
|
||||||
#include "ompi/mpi/fortran/mpif-h/bindings.h"
|
#include "ompi/mpi/fortran/mpif-h/bindings.h"
|
||||||
#include "ompi/mpi/fortran/base/constants.h"
|
#include "ompi/mpi/fortran/base/constants.h"
|
||||||
|
#include "ompi/communicator/communicator.h"
|
||||||
|
|
||||||
#if OMPI_BUILD_MPI_PROFILING
|
#if OMPI_BUILD_MPI_PROFILING
|
||||||
#if OPAL_HAVE_WEAK_SYMBOLS
|
#if OPAL_HAVE_WEAK_SYMBOLS
|
||||||
@ -82,20 +83,22 @@ void ompi_alltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
|
|||||||
OMPI_ARRAY_NAME_DECL(rdispls);
|
OMPI_ARRAY_NAME_DECL(rdispls);
|
||||||
|
|
||||||
c_comm = PMPI_Comm_f2c(*comm);
|
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);
|
||||||
|
|
||||||
|
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]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
|
|
||||||
c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
|
c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
|
||||||
|
|
||||||
OMPI_ARRAY_FINT_2_INT(sendcounts, size);
|
|
||||||
OMPI_ARRAY_FINT_2_INT(sdispls, size);
|
|
||||||
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
|
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
|
||||||
OMPI_ARRAY_FINT_2_INT(rdispls, size);
|
OMPI_ARRAY_FINT_2_INT(rdispls, size);
|
||||||
|
for (int i=0; i<size; i++) {
|
||||||
while (size > 0) {
|
c_recvtypes[i] = PMPI_Type_f2c(recvtypes[i]);
|
||||||
c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]);
|
|
||||||
c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]);
|
|
||||||
--size;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
|
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(sdispls);
|
||||||
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
|
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
|
||||||
OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
|
OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
|
||||||
free(c_sendtypes);
|
if (MPI_IN_PLACE != sendbuf) {
|
||||||
|
free(c_sendtypes);
|
||||||
|
}
|
||||||
free(c_recvtypes);
|
free(c_recvtypes);
|
||||||
}
|
}
|
||||||
|
@ -10,8 +10,8 @@
|
|||||||
* Copyright (c) 2004-2005 The Regents of the University of California.
|
* Copyright (c) 2004-2005 The Regents of the University of California.
|
||||||
* All rights reserved.
|
* All rights reserved.
|
||||||
* Copyright (c) 2011-2012 Cisco Systems, Inc. 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.
|
* and Technology (RIST). All rights reserved.
|
||||||
* $COPYRIGHT$
|
* $COPYRIGHT$
|
||||||
*
|
*
|
||||||
* Additional copyrights may follow
|
* Additional copyrights may follow
|
||||||
@ -23,6 +23,7 @@
|
|||||||
|
|
||||||
#include "ompi/mpi/fortran/mpif-h/bindings.h"
|
#include "ompi/mpi/fortran/mpif-h/bindings.h"
|
||||||
#include "ompi/mpi/fortran/base/constants.h"
|
#include "ompi/mpi/fortran/base/constants.h"
|
||||||
|
#include "ompi/communicator/communicator.h"
|
||||||
|
|
||||||
#if OMPI_BUILD_MPI_PROFILING
|
#if OMPI_BUILD_MPI_PROFILING
|
||||||
#if OPAL_HAVE_WEAK_SYMBOLS
|
#if OPAL_HAVE_WEAK_SYMBOLS
|
||||||
@ -83,21 +84,24 @@ void ompi_ialltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
|
|||||||
OMPI_ARRAY_NAME_DECL(rdispls);
|
OMPI_ARRAY_NAME_DECL(rdispls);
|
||||||
|
|
||||||
c_comm = PMPI_Comm_f2c(*comm);
|
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);
|
||||||
|
|
||||||
|
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]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
|
|
||||||
c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
|
c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
|
||||||
|
|
||||||
OMPI_ARRAY_FINT_2_INT(sendcounts, size);
|
|
||||||
OMPI_ARRAY_FINT_2_INT(sdispls, size);
|
|
||||||
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
|
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
|
||||||
OMPI_ARRAY_FINT_2_INT(rdispls, size);
|
OMPI_ARRAY_FINT_2_INT(rdispls, size);
|
||||||
|
for (int i=0; i<size; i++) {
|
||||||
while (size > 0) {
|
c_recvtypes[i] = PMPI_Type_f2c(recvtypes[i]);
|
||||||
c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]);
|
|
||||||
c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]);
|
|
||||||
--size;
|
|
||||||
}
|
}
|
||||||
|
c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
|
||||||
|
|
||||||
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
|
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
|
||||||
sendbuf = (char *) OMPI_F2C_BOTTOM(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(sdispls);
|
||||||
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
|
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
|
||||||
OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
|
OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
|
||||||
free(c_sendtypes);
|
if (MPI_IN_PLACE != sendbuf) {
|
||||||
|
free(c_sendtypes);
|
||||||
|
}
|
||||||
free(c_recvtypes);
|
free(c_recvtypes);
|
||||||
}
|
}
|
||||||
|
Загрузка…
x
Ссылка в новой задаче
Block a user