1
1
openmpi/ompi/mca/coll/basic/coll_basic_allgatherv.c

153 строки
4.3 KiB
C
Исходник Обычный вид История

/*
* Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
* University Research and Technology
* Corporation. All rights reserved.
* Copyright (c) 2004-2006 The University of Tennessee and The University
* of Tennessee Research Foundation. All rights
* reserved.
* Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
*
* $HEADER$
*/
#include "ompi_config.h"
#include "coll_basic.h"
#include "mpi.h"
#include "ompi/datatype/datatype.h"
#include "ompi/constants.h"
#include "ompi/mca/coll/coll.h"
#include "ompi/mca/coll/base/coll_tags.h"
#include "coll_basic.h"
/*
* allgatherv_intra
*
* Function: - allgatherv using other MPI collectives
* Accepts: - same as MPI_Allgatherv()
* Returns: - MPI_SUCCESS or error code
*/
int
mca_coll_basic_allgatherv_intra(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
int i, size, rank ;
int err;
MPI_Aint extent;
MPI_Aint lb;
char *send_buf = NULL;
struct ompi_datatype_t *newtype, *send_type;
size = ompi_comm_size(comm);
rank = ompi_comm_rank(comm);
/*
* We don't have a root process defined. Arbitrarily assign root
* to process with rank 0 (OMPI convention)
*/
if (MPI_IN_PLACE == sbuf) {
ompi_ddt_get_extent(rdtype, &lb, &extent);
send_type = rdtype;
send_buf = (char*)rbuf;
for (i = 0; i < rank; ++i) {
send_buf += (rcounts[i] * extent);
}
} else {
send_buf = (char*)sbuf;
send_type = sdtype;
}
err = comm->c_coll.coll_gatherv(send_buf,
rcounts[rank], send_type,rbuf,
rcounts, disps, rdtype, 0,
comm);
if (MPI_SUCCESS != err) {
return err;
}
/*
* we now have all the data in the root's rbuf. Need to
* broadcast the data out to the other processes
*
* Need to define a datatype that captures the different vectors
* from each process. MPI_TYPE_INDEXED with params
* size,rcount,displs,rdtype,newtype
* should do the trick.
* Use underlying ddt functions to create, and commit the
* new datatype on each process, then broadcast and destroy the
* datatype.
*/
err = ompi_ddt_create_indexed(size,rcounts,disps,rdtype,&newtype);
if (MPI_SUCCESS != err) {
return err;
}
err = ompi_ddt_commit(&newtype);
if(MPI_SUCCESS != err) {
return err;
}
comm->c_coll.coll_bcast( rbuf, 1 ,newtype,0,comm);
ompi_ddt_destroy (&newtype);
return MPI_SUCCESS;
}
/*
* allgatherv_inter
*
* Function: - allgatherv using other MPI collectives
* Accepts: - same as MPI_Allgatherv()
* Returns: - MPI_SUCCESS or error code
*/
int
mca_coll_basic_allgatherv_inter(void *sbuf, int scount,
struct ompi_datatype_t *sdtype,
void *rbuf, int *rcounts, int *disps,
struct ompi_datatype_t *rdtype,
struct ompi_communicator_t *comm)
{
int size, rsize;
bug fixes for the MPI-2 extended collective operations. All inter-collectives seem to pass now the test without coredumps etc. Checking for MPI_Alltollw(intra)...working Checking for MPI_Exscan: testing MPI_MAX...........working testing MPI_MIN...........working testing MPI_SUM...........working testing MPI_PROD..........working testing MPI_LAND..........working testing MPI_LOR...........working testing MPI_LXOR..........working testing MPI_BAND..........working testing MPI_BOR...........working testing MPI_BXOR..........working Checking for MPI_Bcast.............working Checking for MPI_Allreduce.........working Checking for MPI_Reduce............working Checking for MPI_Barrier...........working Checking for MPI_Gather............working Checking for MPI_Gatherv...........working Checking for MPI_Scatter...........working Checking for MPI_Scatterv..........working Checking for MPI_Allgather.........working Checking for MPI_Allgatherv........working Checking for MPI_Alltoall..........working Checking for MPI_Alltoallv.........working Checking for MPI_Alltollw(inter)...working Checking for MPI_Reduce_scatter....working Checking for MPI_Bcast.............working Checking for MPI_Allreduce.........working Checking for MPI_Reduce............working Checking for MPI_Barrier...........working Checking for MPI_Gather............working Checking for MPI_Gatherv...........working Checking for MPI_Scatter...........working Checking for MPI_Scatterv..........working Checking for MPI_Allgather.........working Checking for MPI_Allgatherv........working Checking for MPI_Alltoall..........working Checking for MPI_Alltoallv.........working Checking for MPI_Alltollw(inter)...working Checking for MPI_Reduce_scatter....working This commit was SVN r1903.
2004-08-05 22:52:14 +04:00
int err, i;
int *scounts = NULL;
int *sdisps = NULL;
rsize = ompi_comm_remote_size(comm);
size = ompi_comm_size(comm);
scounts = (int *) malloc(rsize * sizeof(int));
sdisps = (int *) calloc(rsize, sizeof(int));
if (NULL == scounts || NULL == sdisps) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
for (i = 0; i < rsize; i++) {
scounts[i] = scount;
bug fixes for the MPI-2 extended collective operations. All inter-collectives seem to pass now the test without coredumps etc. Checking for MPI_Alltollw(intra)...working Checking for MPI_Exscan: testing MPI_MAX...........working testing MPI_MIN...........working testing MPI_SUM...........working testing MPI_PROD..........working testing MPI_LAND..........working testing MPI_LOR...........working testing MPI_LXOR..........working testing MPI_BAND..........working testing MPI_BOR...........working testing MPI_BXOR..........working Checking for MPI_Bcast.............working Checking for MPI_Allreduce.........working Checking for MPI_Reduce............working Checking for MPI_Barrier...........working Checking for MPI_Gather............working Checking for MPI_Gatherv...........working Checking for MPI_Scatter...........working Checking for MPI_Scatterv..........working Checking for MPI_Allgather.........working Checking for MPI_Allgatherv........working Checking for MPI_Alltoall..........working Checking for MPI_Alltoallv.........working Checking for MPI_Alltollw(inter)...working Checking for MPI_Reduce_scatter....working Checking for MPI_Bcast.............working Checking for MPI_Allreduce.........working Checking for MPI_Reduce............working Checking for MPI_Barrier...........working Checking for MPI_Gather............working Checking for MPI_Gatherv...........working Checking for MPI_Scatter...........working Checking for MPI_Scatterv..........working Checking for MPI_Allgather.........working Checking for MPI_Allgatherv........working Checking for MPI_Alltoall..........working Checking for MPI_Alltoallv.........working Checking for MPI_Alltollw(inter)...working Checking for MPI_Reduce_scatter....working This commit was SVN r1903.
2004-08-05 22:52:14 +04:00
}
err = comm->c_coll.coll_alltoallv(sbuf, scounts, sdisps, sdtype,
rbuf, rcounts, disps, rdtype, comm);
if (NULL != sdisps) {
free(sdisps);
}
if (NULL != scounts) {
free(scounts);
}
return err;
}