static ompi_datatype_t* test_create_blacs_type( void )
{
ompi_datatype_t *pdt;
ompi_ddt_create_indexed( 18, blacs_length, blacs_indices, &ompi_mpi_int, &pdt );
ompi_ddt_commit( &pdt );
if( outputFlags & DUMP_DATA_AFTER_COMMIT ) {
ompi_ddt_dump( pdt );
}
return pdt;
}
static ompi_datatype_t* test_matrix_borders( unsigned int size, unsigned int width )
{
ompi_datatype_t *pdt, *pdt_line;
int disp[2];
int blocklen[2];
disp[0] = 0;
blocklen[0] = width;
disp[1] = (size - width) * sizeof(double);
blocklen[1] = width;
ompi_ddt_create_indexed( 2, blocklen, disp, ompi_ddt_basicDatatypes[DT_DOUBLE],
&pdt_line );
ompi_ddt_create_contiguous( size, pdt_line, &pdt );
OBJ_RELEASE( pdt_line ); /*assert( pdt_line == NULL );*/
return pdt;
}
ompi_datatype_t* lower_matrix( unsigned int mat_size )
{
int *disp, *blocklen;
unsigned int i;
ompi_datatype_t* upper;
disp = (int*)malloc( sizeof(int) * mat_size );
blocklen = (int*)malloc( sizeof(int) * mat_size );
for( i = 0; i < mat_size; i++ ) {
disp[i] = i * mat_size;
blocklen[i] = i;
}
ompi_ddt_create_indexed( mat_size, blocklen, disp, ompi_ddt_basicDatatypes[DT_DOUBLE],
&upper );
free( disp );
free( blocklen );
return upper;
}
static ompi_datatype_t* upper_matrix( unsigned int mat_size )
{
int *disp, *blocklen;
unsigned int i;
ompi_datatype_t* upper;
disp = (int*)malloc( sizeof(int) * mat_size );
blocklen = (int*)malloc( sizeof(int) * mat_size );
for( i = 0; i < mat_size; i++ ) {
disp[i] = i * mat_size + i;
blocklen[i] = mat_size - i;
}
ompi_ddt_create_indexed( mat_size, blocklen, disp, ompi_ddt_basicDatatypes[DT_DOUBLE],
&upper );
ompi_ddt_commit( &upper );
if( outputFlags & DUMP_DATA_AFTER_COMMIT ) {
ompi_ddt_dump( upper );
}
free( disp );
free( blocklen );
return upper;
}
static int mpich_typeub3( void )
{
int blocklen[2], err = 0, idisp[3];
size_t sz;
MPI_Aint disp[3], lb, ub, ex;
ompi_datatype_t *types[3], *dt1, *dt2, *dt3, *dt4, *dt5;
/* Create a datatype with explicit LB and UB */
blocklen[0] = 1;
blocklen[1] = 1;
blocklen[2] = 1;
disp[0] = -3;
disp[1] = 0;
disp[2] = 6;
types[0] = &ompi_mpi_lb; /* ompi_ddt_basicDatatypes[DT_LB]; */
types[1] = &ompi_mpi_int; /* ompi_ddt_basicDatatypes[DT_INT]; */
types[2] = &ompi_mpi_ub; /* ompi_ddt_basicDatatypes[DT_UB]; */
/* Generate samples for contiguous, hindexed, hvector, indexed, and vector (struct and contiguous tested in typeub2) */
ompi_ddt_create_struct(3,blocklen,disp, types,&dt1);
ompi_ddt_commit(&dt1);
/* This type is the same as in typeub2, and is tested there */
types[0]=dt1; types[1]=dt1;
blocklen[0]=1; blocklen[1]=1;
disp[0]=-4; disp[1]=7;
idisp[0]=-4; idisp[1]=7;
ompi_ddt_create_hindexed( 2, blocklen, disp, dt1, &dt2 );
ompi_ddt_commit( &dt2 );
ompi_ddt_type_lb( dt2, &lb ); ompi_ddt_type_ub( dt2, &ub );
ompi_ddt_type_extent( dt2, &ex ); ompi_ddt_type_size( dt2, &sz );
if (lb != -7 || ub != 13 || ex != 20) {
printf("hindexed lb %d ub %d extent %d size %d\n", (int)-7, (int)13, (int)20, (int)sz);
printf("hindexed lb %d ub %d extent %d size %d\n", (int)lb, (int)ub, (int)ex, (int)sz);
err++;
}
else
printf( "hindexed ok\n" );
ompi_ddt_create_indexed( 2, blocklen, idisp, dt1, &dt3 );
ompi_ddt_commit( &dt3 );
ompi_ddt_type_lb( dt3, &lb ); ompi_ddt_type_ub( dt3, &ub );
ompi_ddt_type_extent( dt3, &ex ); ompi_ddt_type_size( dt3, &sz );
if (lb != -39 || ub != 69 || ex != 108) {
printf("indexed lb %d ub %d extent %d size %d\n", (int)-39, (int)69, (int)108, (int)sz);
printf("indexed lb %d ub %d extent %d size %d\n", (int)lb, (int)ub, (int)ex, (int)sz);
err++;
}
else
printf( "indexed ok\n" );
ompi_ddt_create_hvector( 2, 1, 14, dt1, &dt4 );
ompi_ddt_commit( &dt4 );
ompi_ddt_type_lb( dt4, &lb ); ompi_ddt_type_ub( dt4, &ub );
ompi_ddt_type_extent( dt4, &ex ); ompi_ddt_type_size( dt4, &sz );
if (lb != -3 || ub != 20 || ex != 23) {
printf("hvector lb %d ub %d extent %d size %d\n", (int)-3, (int)20, (int)23, (int)sz);
printf("hvector lb %d ub %d extent %d size %d\n", (int)lb, (int)ub, (int)ex, (int)sz);
err++;
}
else
printf( "hvector ok\n" );
ompi_ddt_create_vector( 2, 1, 14, dt1, &dt5 );
ompi_ddt_commit( &dt5 );
ompi_ddt_type_lb( dt5, &lb ); ompi_ddt_type_ub( dt5, &ub );
ompi_ddt_type_extent( dt5, &ex ); ompi_ddt_type_size( dt5, &sz );
if (lb != -3 || ub != 132 || ex != 135) {
printf("vector lb %d ub %d extent %d size %d\n", (int)-3, (int)132, (int)135, (int)sz);
printf("vector lb %d ub %d extent %d size %d\n", (int)lb, (int)ub, (int)ex, (int)sz);
err++;
}
else
printf( "vector ok\n" );
OBJ_RELEASE( dt1 ); /*assert( dt1 == NULL );*/
OBJ_RELEASE( dt2 ); /*assert( dt2 == NULL );*/
OBJ_RELEASE( dt3 ); /*assert( dt3 == NULL );*/
OBJ_RELEASE( dt4 ); /*assert( dt4 == NULL );*/
OBJ_RELEASE( dt5 ); assert( dt5 == NULL );
return err;
}
/*
* scatterv_inter
*
* Function: - scatterv operation
* Accepts: - same arguments as MPI_Scatterv()
* Returns: - MPI_SUCCESS or error code
*/
int
mca_coll_inter_scatterv_inter(void *sbuf, int *scounts,
int *disps, struct ompi_datatype_t *sdtype,
void *rbuf, int rcount,
struct ompi_datatype_t *rdtype, int root,
struct ompi_communicator_t *comm,
mca_coll_base_module_t *module)
{
int i, rank, size, err, total, size_local;
int *counts=NULL,*displace=NULL;
char *ptmp=NULL;
MPI_Aint incr;
MPI_Aint extent;
MPI_Aint lb;
ompi_datatype_t *ndtype;
/* Initialize */
rank = ompi_comm_rank(comm);
size = ompi_comm_remote_size(comm);
size_local = ompi_comm_size(comm);
if (MPI_PROC_NULL == root) {
/* do nothing */
err = OMPI_SUCCESS;
} else if (MPI_ROOT != root) {
if(0 == rank) {
/* local root recieves the counts from the root */
counts = (int *)malloc(sizeof(int) * size_local);
err = MCA_PML_CALL(recv(counts, size_local, MPI_INT,
root, MCA_COLL_BASE_TAG_SCATTERV,
comm, MPI_STATUS_IGNORE));
if (OMPI_SUCCESS != err) {
return err;
}
/* calculate the whole buffer size and recieve it from root */
err = ompi_ddt_get_extent(rdtype, &lb, &extent);
if (OMPI_SUCCESS != err) {
return OMPI_ERROR;
}
incr = 0;
for (i = 0; i < size_local; i++) {
incr = incr + extent*counts[i];
}
if ( incr > 0 ) {
ptmp = (char*)malloc(incr);
if (NULL == ptmp) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
}
total = 0;
for (i = 0; i < size_local; i++) {
total = total + counts[i];
}
err = MCA_PML_CALL(recv(ptmp, total, rdtype,
root, MCA_COLL_BASE_TAG_SCATTERV,
comm, MPI_STATUS_IGNORE));
if (OMPI_SUCCESS != err) {
return err;
}
/* set the local displacement i.e. no displacements here */
displace = (int *)malloc(sizeof(int) * size_local);
displace[0] = 0;
for (i = 1; i < size_local; i++) {
displace[i] = displace[i-1] + counts[i-1];
}
}
/* perform the scatterv locally */
err = comm->c_local_comm->c_coll.coll_scatterv(ptmp, counts, displace,
rdtype, rbuf, rcount,
rdtype, 0, comm->c_local_comm,
comm->c_local_comm->c_coll.coll_scatterv_module);
if (OMPI_SUCCESS != err) {
return err;
}
if (NULL != ptmp) {
free(ptmp);
}
if (NULL != displace) {
free(displace);
}
if (NULL != counts) {
free(counts);
}
} else {
err = MCA_PML_CALL(send(scounts, size, MPI_INT, 0,
MCA_COLL_BASE_TAG_SCATTERV,
MCA_PML_BASE_SEND_STANDARD, comm));
if (OMPI_SUCCESS != err) {
return err;
}
ompi_ddt_create_indexed(size,scounts,disps,sdtype,&ndtype);
ompi_ddt_commit(&ndtype);
err = MCA_PML_CALL(send(sbuf, 1, ndtype, 0,
MCA_COLL_BASE_TAG_SCATTERV,
MCA_PML_BASE_SEND_STANDARD, comm));
if (OMPI_SUCCESS != err) {
return err;
}
ompi_ddt_destroy(&ndtype);
}
/* All done */
return err;
}
/*
* allgatherv_inter
*
* Function: - allgatherv using other MPI collectives
* Accepts: - same as MPI_Allgatherv()
* Returns: - MPI_SUCCESS or error code
*/
int
mca_coll_inter_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,
mca_coll_base_module_t *module)
{
int i, rank, size, size_local, total=0, err;
int *count=NULL,*displace=NULL;
char *ptmp=NULL;
MPI_Aint incr;
MPI_Aint extent;
MPI_Aint lb;
ompi_datatype_t *ndtype;
ompi_request_t *req[2];
rank = ompi_comm_rank(comm);
size_local = ompi_comm_size(comm->c_local_comm);
size = ompi_comm_remote_size(comm);
if (0 == rank) {
count = (int *)malloc(sizeof(int) * size_local);
if (NULL == count) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
displace = (int *)malloc(sizeof(int) * size_local);
if (NULL == displace) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
}
/* Local gather to get the scount of each process */
err = comm->c_local_comm->c_coll.coll_gather(&scount, 1, MPI_INT,
count, 1, MPI_INT,
0, comm->c_local_comm,
comm->c_local_comm->c_coll.coll_gather_module);
if (OMPI_SUCCESS != err) {
return err;
}
if(0 == rank) {
displace[0] = 0;
for (i = 1; i < size_local; i++) {
displace[i] = displace[i-1] + count[i-1];
}
/* Perform the gatherv locally with the first process as root */
err = ompi_ddt_get_extent(sdtype, &lb, &extent);
if (OMPI_SUCCESS != err) {
return OMPI_ERROR;
}
incr = 0;
for (i = 0; i < size_local; i++) {
incr = incr + extent*count[i];
}
ptmp = (char*)malloc(incr);
if (NULL == ptmp) {
return OMPI_ERR_OUT_OF_RESOURCE;
}
}
err = comm->c_local_comm->c_coll.coll_gatherv(sbuf, scount, sdtype,
ptmp, count, displace,
sdtype,0, comm->c_local_comm,
comm->c_local_comm->c_coll.coll_gatherv_module);
if (OMPI_SUCCESS != err) {
return err;
}
ompi_ddt_create_indexed(size,rcounts,disps,rdtype,&ndtype);
ompi_ddt_commit(&ndtype);
if (0 == rank) {
for (i = 0; i < size_local; i++) {
total = total + count[i];
}
/* Exchange data between roots */
err = MCA_PML_CALL(irecv(rbuf, 1, ndtype, 0,
MCA_COLL_BASE_TAG_ALLGATHERV, comm,
&(req[0])));
if (OMPI_SUCCESS != err) {
return err;
}
err = MCA_PML_CALL(isend(ptmp, total, sdtype, 0,
MCA_COLL_BASE_TAG_ALLGATHERV,
MCA_PML_BASE_SEND_STANDARD,
comm, &(req[1])));
if (OMPI_SUCCESS != err) {
return err;
}
err = ompi_request_wait_all(2, req, MPI_STATUSES_IGNORE);
if (OMPI_SUCCESS != err) {
return err;
}
}
/* bcast the message to all the local processes */
err = comm->c_local_comm->c_coll.coll_bcast(rbuf, 1, ndtype,
0, comm->c_local_comm,
comm->c_local_comm->c_coll.coll_bcast_module);
if (OMPI_SUCCESS != err) {
return err;
}
ompi_ddt_destroy(&ndtype);
if (NULL != ptmp) {
free(ptmp);
}
if (NULL != displace) {
free(displace);
}
if (NULL != count) {
free(count);
}
return err;
}
