/*
MPIR_Topology_copy_fn - copies topology information.
*/
int MPIR_Topology_copy_fn(
MPI_Comm old_comm,
int keyval,
void *extra,
void *attr_in,
void *attr_out,
int *flag)
{
MPIR_TOPOLOGY *old_topo = (MPIR_TOPOLOGY *) attr_in;
MPIR_TOPOLOGY *new_topo = (MPIR_TOPOLOGY *) MPIR_SBalloc ( MPIR_topo_els );
if (!new_topo)
return MPI_ERR_EXHAUSTED;
/* Copy topology info */
new_topo->type = old_topo->type;
if (old_topo->type == MPI_CART) {
int i, ndims;
MPIR_SET_COOKIE(&new_topo->cart,MPIR_CART_TOPOL_COOKIE)
new_topo->cart.nnodes = old_topo->cart.nnodes;
new_topo->cart.ndims = ndims = old_topo->cart.ndims;
new_topo->cart.dims = (int *)MALLOC( sizeof(int) * 3 * ndims );
if (!new_topo) return MPI_ERR_EXHAUSTED;
new_topo->cart.periods = new_topo->cart.dims + ndims;
new_topo->cart.position = new_topo->cart.periods + ndims;
for ( i=0; i<ndims; i++ ) {
new_topo->cart.dims[i] = old_topo->cart.dims[i];
new_topo->cart.periods[i] = old_topo->cart.periods[i];
}
for ( i=0; i < ndims; i++ )
new_topo->cart.position[i] = old_topo->cart.position[i];
}
else if (old_topo->type == MPI_GRAPH) {
int i, nnodes;
int *index;
MPIR_SET_COOKIE(&new_topo->graph,MPIR_GRAPH_TOPOL_COOKIE)
new_topo->graph.nnodes = nnodes = old_topo->graph.nnodes;
new_topo->graph.nedges = old_topo->graph.nedges;
index = old_topo->graph.index;
new_topo->graph.index =
(int *)MALLOC(sizeof(int) * (nnodes + index[nnodes-1]) );
if (!new_topo->graph.index) return MPI_ERR_EXHAUSTED;
new_topo->graph.edges = new_topo->graph.index + nnodes;
for ( i=0; i<nnodes; i++ )
new_topo->graph.index[i] = old_topo->graph.index[i];
for ( i=0; i<index[nnodes-1]; i++ )
new_topo->graph.edges[i] = old_topo->graph.edges[i];
}
/* Set attr_out and return a "1" to indicate information was copied */
(*(void **)attr_out) = (void *) new_topo;
(*flag) = 1;
return (MPI_SUCCESS);
}
/*@
MPI_Type_struct - Creates a struct datatype
Input Parameters:
+ count - number of blocks (integer) -- also number of
entries in arrays array_of_types ,
array_of_displacements and array_of_blocklengths
. blocklens - number of elements in each block (array)
. indices - byte displacement of each block (array)
- old_types - type of elements in each block (array
of handles to datatype objects)
Output Parameter:
. newtype - new datatype (handle)
Notes:
If an upperbound is set explicitly by using the MPI datatype 'MPI_UB', the
corresponding index must be positive.
The MPI standard originally made vague statements about padding and alignment;
this was intended to allow the simple definition of structures that could
be sent with a count greater than one. For example,
.vb
struct { int a; char b; } foo;
.ve
may have 'sizeof(foo) > sizeof(int) + sizeof(char)'; for example,
'sizeof(foo) == 2*sizeof(int)'. The initial version of the MPI standard
defined the extent of a datatype as including an `epsilon` that would have
allowed an implementation to make the extent an MPI datatype
for this structure equal to '2*sizeof(int)'.
However, since different systems might define different paddings, there was
much discussion by the MPI Forum about what was the correct value of
epsilon, and one suggestion was to define epsilon as zero.
This would have been the best thing to do in MPI 1.0, particularly since
the 'MPI_UB' type allows the user to easily set the end of the structure.
Unfortunately, this change did not make it into the final document.
Currently, this routine does not add any padding, since the amount of
padding needed is determined by the compiler that the user is using to
build their code, not the compiler used to construct the MPI library.
A later version of MPICH may provide for some natural choices of padding
(e.g., multiple of the size of the largest basic member), but users are
advised to never depend on this, even with vendor MPI implementations.
Instead, if you define a structure datatype and wish to send or receive
multiple items, you should explicitly include an 'MPI_UB' entry as the
last member of the structure. For example, the following code can be used
for the structure foo
.vb
blen[0] = 1; indices[0] = 0; oldtypes[0] = MPI_INT;
blen[1] = 1; indices[1] = &foo.b - &foo; oldtypes[1] = MPI_CHAR;
blen[2] = 1; indices[2] = sizeof(foo); oldtypes[2] = MPI_UB;
MPI_Type_struct( 3, blen, indices, oldtypes, &newtype );
.ve
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
.N MPI_ERR_COUNT
.N MPI_ERR_EXHAUSTED
@*/
int MPI_Type_struct(
int count,
int blocklens[],
MPI_Aint indices[],
MPI_Datatype old_types[],
MPI_Datatype *newtype )
{
struct MPIR_DATATYPE* dteptr;
MPI_Aint ub, lb, high, low, real_ub, real_lb, real_init;
int high_init = 0, low_init = 0;
int i, mpi_errno = MPI_SUCCESS;
MPI_Aint ub_marker = 0, lb_marker = 0; /* to suppress warnings */
MPI_Aint ub_found = 0, lb_found = 0;
int size, total_count;
static char myname[] = "MPI_TYPE_STRUCT";
disableSignal();
/* Check for bad arguments */
if ( count < 0 ) {
mpi_errno = MPIR_Err_setmsg( MPI_ERR_COUNT, MPIR_ERR_DEFAULT, myname,
(char *)0, (char *)0, count );
revertSignal();
return MPIR_ERROR( MPIR_COMM_WORLD, mpi_errno, myname );
}
if (count == 0) {
revertSignal();
return MPI_Type_contiguous( 0, MPI_INT, newtype );
}
/* Check blocklens and old_types arrays and find number of bound */
/* markers */
total_count = 0;
for (i=0; i<count; i++) {
total_count += blocklens[i];
if ( blocklens[i] < 0) {
mpi_errno = MPIR_Err_setmsg( MPI_ERR_ARG, MPIR_ERR_ARG_ARRAY_VAL,
myname, (char *)0, (char *)0,
"blocklens", i, blocklens[i] );
revertSignal();
return MPIR_ERROR( MPIR_COMM_WORLD, mpi_errno,myname);
}
if ( old_types[i] == MPI_DATATYPE_NULL ) {
mpi_errno = MPIR_Err_setmsg( MPI_ERR_TYPE, MPIR_ERR_TYPE_ARRAY_NULL,
myname, (char *)0, (char *)0,
"old_types", i );
revertSignal();
return MPIR_ERROR( MPIR_COMM_WORLD, mpi_errno, myname );
}
}
if (total_count == 0) {
revertSignal();
return MPI_Type_contiguous( 0, MPI_INT, newtype );
}
/* Create and fill in the datatype */
MPIR_ALLOC(dteptr,(struct MPIR_DATATYPE *) MPIR_SBalloc( MPIR_dtes ),MPIR_COMM_WORLD,
MPI_ERR_EXHAUSTED, myname );
*newtype = (MPI_Datatype) MPIR_FromPointer( dteptr );
dteptr->self = *newtype;
MPIR_SET_COOKIE(dteptr,MPIR_DATATYPE_COOKIE)
dteptr->dte_type = MPIR_STRUCT;
dteptr->committed = 0;
dteptr->basic = 0;
dteptr->permanent = 0;
dteptr->is_contig = 0;
dteptr->ref_count = 1;
dteptr->count = count;
dteptr->elements = 0;
dteptr->size = 0;
dteptr->align = 1;
dteptr->has_ub = 0;
dteptr->has_lb = 0;
dteptr->self = *newtype;
/* Create indices and blocklens arrays and fill them */
dteptr->indices = ( MPI_Aint * ) MALLOC( count * sizeof( MPI_Aint ) );
dteptr->blocklens = ( int * ) MALLOC( count * sizeof( int ) );
dteptr->old_types =
( struct MPIR_DATATYPE ** )MALLOC(count*sizeof(struct MPIR_DATATYPE *));
if (!dteptr->indices || !dteptr->blocklens || !dteptr->old_types) {
revertSignal();
return MPIR_ERROR( MPIR_COMM_WORLD, MPI_ERR_EXHAUSTED,
"MPI_TYPE_STRUCT" );
}
high = low = ub = lb = 0;
real_ub = real_lb = 0;
real_init = 0;
/* If data alignment is 2, 4, or 8, then assign dteptr->align to that
value. If 0, then assign dteptr->align to the maximal alignment
requirement. (done below) */
if (ALIGNMENT_VALUE > 0)
dteptr->align = ALIGNMENT_VALUE;
for (i = 0; i < count; i++) {
struct MPIR_DATATYPE *old_dtype_ptr;
old_dtype_ptr = MPIR_GET_DTYPE_PTR(old_types[i]);
MPIR_TEST_DTYPE(old_types[i],old_dtype_ptr,MPIR_COMM_WORLD,
"MPI_TYPE_STRUCT");
dteptr->old_types[i] = MPIR_Type_dup (old_dtype_ptr);
dteptr->indices[i] = indices[i];
dteptr->blocklens[i] = blocklens[i];
/* Keep track of maximal alignment requirement */
if (ALIGNMENT_VALUE == 0) {
if (dteptr->align < old_dtype_ptr->align)
dteptr->align = old_dtype_ptr->align;
}
if ( old_dtype_ptr->dte_type == MPIR_UB ) {
if (ub_found) {
if (indices[i] > ub_marker)
ub_marker = indices[i];
}
else {
ub_marker = indices[i];
ub_found = 1;
}
}
else if ( old_dtype_ptr->dte_type == MPIR_LB ) {
if (lb_found) {
if ( indices[i] < lb_marker ) {
lb_marker = indices[i];
}
}
else {
lb_marker = indices[i];
lb_found = 1;
}
}
else {
/* Since the datatype is NOT a UB or LB, save the real limits */
if (!real_init) {
real_init = 1;
real_lb = old_dtype_ptr->real_lb;
real_ub = old_dtype_ptr->real_ub;
}
else {
if (old_dtype_ptr->real_lb < real_lb)
real_lb = old_dtype_ptr->real_lb;
if (old_dtype_ptr->real_ub > real_ub)
real_ub = old_dtype_ptr->real_ub;
}
/* Next, check to see if datatype has an MPI_LB or MPI_UB
within it...
Make sure to adjust the ub by the selected displacement
and blocklens (blocklens is like Type_contiguous)
*/
if (old_dtype_ptr->has_ub) {
MPI_Aint ub_test;
ub_test = old_dtype_ptr->ub + indices[i] +
(blocklens[i] - 1) * old_dtype_ptr->extent;
if (ub_marker < ub_test || !ub_found) ub_marker = ub_test;
ub_found = 1;
}
if (old_dtype_ptr->has_lb) {
if (!lb_found || lb_marker > (old_dtype_ptr->lb) + indices[i] )
lb_marker = old_dtype_ptr->lb + indices[i];
lb_found = 1;
}
/* Get the ub/lb from the datatype (if a MPI_UB or MPI_LB was
found, then these values will be ignored).
We use the lb of the old type and add the indices
value to it */
lb = indices[i] + old_dtype_ptr->lb;
ub = lb + (blocklens[i] * old_dtype_ptr->extent) ;
if (!high_init) { high = ub; high_init = 1; }
else if (ub > high) high = ub;
if (!low_init ) { low = lb; low_init = 1; }
else if (lb < low) low = lb;
if (ub > lb) {
if ( high < ub ) high = ub;
if ( low > lb ) low = lb;
}
else {
if ( high < lb ) high = lb;
if ( low > ub ) low = ub;
}
dteptr->elements += (blocklens[i] * old_dtype_ptr->elements);
} /* end else */
if (i < count - 1) {
size = old_dtype_ptr->size * blocklens[i];
dteptr->size += size;
}
else {
dteptr->size += (blocklens[i] * old_dtype_ptr->size);
}
} /* end for loop */
/* Set the upper/lower bounds and the extent and size */
if (lb_found) {
dteptr->lb = lb_marker;
dteptr->has_lb = 1;
}
else
dteptr->lb = (low_init ? low : 0);
if (ub_found) {
dteptr->ub = ub_marker;
dteptr->has_ub = 1;
}
else
dteptr->ub = (high_init ? high: 0);
dteptr->extent = dteptr->ub - dteptr->lb ;
dteptr->real_ub = real_ub;
dteptr->real_lb = real_lb;
/* If there is no explicit ub/lb marker, make the extent/ub fit the
alignment of the largest basic item, if that structure alignment is
chosen */
if (!lb_found && !ub_found) {
MPI_Aint eps_offset;
/* Since data is always offset by the extent, is the extent that
we must adjust. */
eps_offset = dteptr->extent % dteptr->align;
if (eps_offset > 0) {
dteptr->ub += (dteptr->align - eps_offset);
dteptr->extent = dteptr->ub - dteptr->lb;
}
}
# if defined(MPID_HAS_TYPE_STRUCT)
{
mpi_errno = MPID_Type_struct(count,
blocklens,
indices,
old_types,
*newtype);
}
# endif
revertSignal();
return (mpi_errno);
}
/*@
MPI_Cart_create - Makes a new communicator to which topology information
has been attached
Input Parameters:
+ comm_old - input communicator (handle)
. ndims - number of dimensions of cartesian grid (integer)
. dims - integer array of size ndims specifying the number of processes in
each dimension
. periods - logical array of size ndims specifying whether the grid is
periodic (true) or not (false) in each dimension
- reorder - ranking may be reordered (true) or not (false) (logical)
Output Parameter:
. comm_cart - communicator with new cartesian topology (handle)
Algorithm:
We ignore 'reorder' info currently.
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TOPOLOGY
.N MPI_ERR_DIMS
.N MPI_ERR_ARG
@*/
int MPI_Cart_create ( MPI_Comm comm_old, int ndims, int *dims, int *periods,
int reorder, MPI_Comm *comm_cart )
{
int range[1][3];
MPI_Group group_old, group;
int i, rank, num_ranks = 1;
int mpi_errno = MPI_SUCCESS;
int flag, size;
MPIR_TOPOLOGY *topo;
struct MPIR_COMMUNICATOR *comm_old_ptr;
static char myname[] = "MPI_CART_CREATE";
TR_PUSH(myname);
comm_old_ptr = MPIR_GET_COMM_PTR(comm_old);
/* Check validity of arguments */
#ifndef MPIR_NO_ERROR_CHECKING
MPIR_TEST_MPI_COMM(comm_old,comm_old_ptr,comm_old_ptr,myname);
MPIR_TEST_ARG(comm_cart);
MPIR_TEST_ARG(periods);
if (ndims < 1 || dims == (int *)0) mpi_errno = MPI_ERR_DIMS;
if (mpi_errno)
return MPIR_ERROR(comm_old_ptr, mpi_errno, myname );
/* Check for Intra-communicator */
MPI_Comm_test_inter ( comm_old, &flag );
if (flag)
return MPIR_ERROR(comm_old_ptr,
MPIR_ERRCLASS_TO_CODE(MPI_ERR_COMM,MPIR_ERR_COMM_INTER), myname );
#endif
/* Determine number of ranks in topology */
for ( i=0; i<ndims; i++ )
num_ranks *= (dims[i]>0)?dims[i]:-dims[i];
if ( num_ranks < 1 ) {
(*comm_cart) = MPI_COMM_NULL;
return MPIR_ERROR( comm_old_ptr, MPI_ERR_TOPOLOGY, myname );
}
/* Is the old communicator big enough? */
MPIR_Comm_size (comm_old_ptr, &size);
if (num_ranks > size) {
mpi_errno = MPIR_Err_setmsg( MPI_ERR_TOPOLOGY, MPIR_ERR_TOPO_TOO_LARGE,
myname,
"Topology size is larger than size of communicator",
"Topology size %d is greater than communicator size %d",
num_ranks, size );
return MPIR_ERROR(comm_old_ptr, mpi_errno, myname );
}
/* Make new comm */
range[0][0] = 0; range[0][1] = num_ranks - 1; range[0][2] = 1;
MPI_Comm_group ( comm_old, &group_old );
MPI_Group_range_incl ( group_old, 1, range, &group );
MPI_Comm_create ( comm_old, group, comm_cart );
MPI_Group_free( &group );
MPI_Group_free( &group_old );
/* Store topology information in new communicator */
if ( (*comm_cart) != MPI_COMM_NULL ) {
MPIR_ALLOC(topo,(MPIR_TOPOLOGY *) MPIR_SBalloc ( MPIR_topo_els ),
comm_old_ptr,MPI_ERR_EXHAUSTED,myname);
MPIR_SET_COOKIE(&topo->cart,MPIR_CART_TOPOL_COOKIE)
topo->cart.type = MPI_CART;
topo->cart.nnodes = num_ranks;
topo->cart.ndims = ndims;
MPIR_ALLOC(topo->cart.dims,(int *)MALLOC( sizeof(int) * 3 * ndims ),
comm_old_ptr,MPI_ERR_EXHAUSTED,myname);
topo->cart.periods = topo->cart.dims + ndims;
topo->cart.position = topo->cart.periods + ndims;
for ( i=0; i<ndims; i++ ) {
topo->cart.dims[i] = dims[i];
topo->cart.periods[i] = periods[i];
}
/* Compute my position */
MPI_Comm_rank ( (*comm_cart), &rank );
for ( i=0; i < ndims; i++ ) {
num_ranks = num_ranks / dims[i];
topo->cart.position[i] = rank / num_ranks;
rank = rank % num_ranks;
}
/* cache topology information */
MPI_Attr_put ( (*comm_cart), MPIR_TOPOLOGY_KEYVAL, (void *)topo );
}
TR_POP;
return (mpi_errno);
}
