int main( int argc, char *argv[] )
{
int errs = 0;
int wrank, wsize, mrank, msize, inter_rank;
int np = 2;
int errcodes[2];
int rrank = -1;
MPI_Comm parentcomm, intercomm, intercomm2, even_odd_comm, merged_world;
int can_spawn;
MTest_Init( &argc, &argv );
errs += MTestSpawnPossible(&can_spawn);
if (can_spawn) {
MPI_Comm_rank( MPI_COMM_WORLD, &wrank );
MPI_Comm_size( MPI_COMM_WORLD, &wsize );
if (wsize != 2) {
printf( "world size != 2, this test will not work correctly\n" );
errs++;
}
MPI_Comm_get_parent( &parentcomm );
if (parentcomm == MPI_COMM_NULL) {
MPI_Comm_spawn( (char*)"./spaiccreate2", MPI_ARGV_NULL, np,
MPI_INFO_NULL, 0, MPI_COMM_WORLD,
&intercomm, errcodes );
}
else {
intercomm = parentcomm;
}
MPI_Intercomm_merge( intercomm, (parentcomm == MPI_COMM_NULL ? 0 : 1), &merged_world );
MPI_Comm_rank( merged_world, &mrank );
MPI_Comm_size( merged_world, &msize );
MPI_Comm_split( merged_world, mrank % 2, wrank, &even_odd_comm );
MPI_Intercomm_create( even_odd_comm, 0, merged_world, (mrank + 1) % 2, 123, &intercomm2 );
MPI_Comm_rank( intercomm2, &inter_rank );
/* odds receive from evens */
MPI_Sendrecv( &inter_rank, 1, MPI_INT, inter_rank, 456,
&rrank, 1, MPI_INT, inter_rank, 456, intercomm2, MPI_STATUS_IGNORE );
if (rrank != inter_rank) {
printf( "Received %d from %d; expected %d\n",
rrank, inter_rank, inter_rank );
errs++;
}
MPI_Barrier( intercomm2 );
MPI_Comm_free( &intercomm );
MPI_Comm_free( &intercomm2 );
MPI_Comm_free( &merged_world );
MPI_Comm_free( &even_odd_comm );
/* Note that the MTest_Finalize get errs only over COMM_WORLD */
/* Note also that both the parent and child will generate "No Errors"
if both call MTest_Finalize */
if (parentcomm == MPI_COMM_NULL) {
MTest_Finalize( errs );
}
} else {
MTest_Finalize( errs );
}
MPI_Finalize();
return 0;
}
static void
do_target(char* argv[], MPI_Comm parent)
{
int rank, first = 0, err;
MPI_Comm intra, inter, merge1;
if( 0 == strcmp(argv[1], cmd_argv1) ) first = 1;
/*MPI_Comm_set_errhandler(parent, MPI_ERRORS_RETURN);*/
err = MPI_Intercomm_merge( parent, 1, &intra );
MPI_Comm_rank(intra, &rank);
if( first ) {
printf( "%s: MPI_Intercomm_create( intra, 0, intra, MPI_COMM_NULL, %d, &inter) [rank %d]\n", whoami, tag, rank );
err = MPI_Intercomm_create( intra, 0, MPI_COMM_WORLD, 0, tag, &inter);
printf( "%s: intercomm_create (%d)\n", whoami, err );
} else {
printf( "%s: MPI_Intercomm_create( MPI_COMM_WORLD, 0, intra, 0, %d, &inter) [rank %d]\n", whoami, tag, rank );
err = MPI_Intercomm_create( MPI_COMM_WORLD, 0, intra, 0, tag, &inter);
printf( "%s: intercomm_create (%d)\n", whoami, err );
}
err = MPI_Intercomm_merge( inter, 0, &merge1 );
MPI_Comm_rank(merge1, &rank);
printf( "%s: intercomm_merge(%d) (%d) [rank %d]\n", whoami, first, err, rank );
sleep(20);
err = MPI_Barrier(merge1);
printf( "%s: barrier (%d)\n", whoami, err );
MPI_Comm_free(&merge1);
MPI_Comm_free(&inter);
MPI_Comm_free(&intra);
MPI_Comm_disconnect(&parent);
}
/* Create a processor group containing the processes in pid_list.
*
* NOTE: pid_list list must be identical and sorted on all processes
*/
void pgroup_create(int grp_size, int *pid_list, MPI_Comm *group_out) {
int i, grp_me, me, nproc, merge_size;
MPI_Comm pgroup, inter_pgroup;
MPI_Comm_rank(MPI_COMM_WORLD, &me);
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
/* CASE: Group size 0 */
if (grp_size == 0) {
*group_out = MPI_COMM_NULL;
return;
}
/* CASE: Group size 1 */
else if (grp_size == 1 && pid_list[0] == me) {
*group_out = MPI_COMM_SELF;
return;
}
/* CHECK: If I'm not a member, return COMM_NULL */
grp_me = -1;
for (i = 0; i < grp_size; i++) {
if (pid_list[i] == me) {
grp_me = i;
break;
}
}
if (grp_me < 0) {
*group_out = MPI_COMM_NULL;
return;
}
pgroup = MPI_COMM_SELF;
for (merge_size = 1; merge_size < grp_size; merge_size *= 2) {
int gid = grp_me / merge_size;
MPI_Comm pgroup_old = pgroup;
if (gid % 2 == 0) {
/* Check if right partner doesn't exist */
if ((gid+1)*merge_size >= grp_size)
continue;
MPI_Intercomm_create(pgroup, 0, MPI_COMM_WORLD, pid_list[(gid+1)*merge_size], INTERCOMM_TAG, &inter_pgroup);
MPI_Intercomm_merge(inter_pgroup, 0 /* LOW */, &pgroup);
} else {
MPI_Intercomm_create(pgroup, 0, MPI_COMM_WORLD, pid_list[(gid-1)*merge_size], INTERCOMM_TAG, &inter_pgroup);
MPI_Intercomm_merge(inter_pgroup, 1 /* HIGH */, &pgroup);
}
MPI_Comm_free(&inter_pgroup);
if (pgroup_old != MPI_COMM_SELF) MPI_Comm_free(&pgroup_old);
}
*group_out = pgroup;
}
/** Create an ARMCI group that contains a subset of the nodes in the parent
* group. Collective across output group.
*
* @param[in] grp_size Number of entries in pid_list.
* @param[in] pid_list Sorted list of process ids that will be in the new group.
* @param[out] armci_grp_out The new ARMCI group, only valid on group members.
* @param[in] armci_grp_parent The parent of the new ARMCI group.
*/
static inline void ARMCI_Group_create_comm_noncollective(int grp_size, int *pid_list, ARMCI_Group *armci_grp_out,
ARMCI_Group *armci_grp_parent) {
const int INTERCOMM_TAG = 42;
int i, grp_me, me, merge_size;
MPI_Comm pgroup, inter_pgroup;
me = armci_grp_parent->rank;
/* CHECK: If I'm not a member, return COMM_NULL */
grp_me = -1;
for (i = 0; i < grp_size; i++) {
if (pid_list[i] == me) {
grp_me = i;
break;
}
}
if (grp_me < 0) {
armci_grp_out->comm = MPI_COMM_NULL;
return;
}
/* CASE: Group size 1 */
else if (grp_size == 1 && pid_list[0] == me) {
MPI_Comm_dup(MPI_COMM_SELF, &armci_grp_out->comm);
return;
}
pgroup = MPI_COMM_SELF;
/* Recursively merge adjacent groups until only one group remains. */
for (merge_size = 1; merge_size < grp_size; merge_size *= 2) {
int gid = grp_me / merge_size;
MPI_Comm pgroup_old = pgroup;
if (gid % 2 == 0) {
/* Check if right partner doesn't exist */
if ((gid+1)*merge_size >= grp_size)
continue;
MPI_Intercomm_create(pgroup, 0, armci_grp_parent->noncoll_pgroup_comm, pid_list[(gid+1)*merge_size], INTERCOMM_TAG, &inter_pgroup);
MPI_Intercomm_merge(inter_pgroup, 0 /* LOW */, &pgroup);
} else {
MPI_Intercomm_create(pgroup, 0, armci_grp_parent->noncoll_pgroup_comm, pid_list[(gid-1)*merge_size], INTERCOMM_TAG, &inter_pgroup);
MPI_Intercomm_merge(inter_pgroup, 1 /* HIGH */, &pgroup);
}
MPI_Comm_free(&inter_pgroup);
if (pgroup_old != MPI_COMM_SELF) MPI_Comm_free(&pgroup_old);
}
armci_grp_out->comm = pgroup;
}
static void
do_parent(char *argv[], int rank, int count)
{
MPI_Comm ab_inter, ab_intra, ac_inter, ac_intra, ab_c_inter, abc_intra;
int err;
err = spawn_and_merge( argv, cmd_argv1, count, &ab_inter, &ab_intra );
err = spawn_and_merge( argv, cmd_argv2, count, &ac_inter, &ac_intra );
printf( "%s: MPI_Intercomm_create( ab_intra, 0, ac_intra, %d, %d, &inter) (%d)\n",
whoami, count, tag, err );
err = MPI_Intercomm_create( ab_intra, 0, ac_intra, count, tag, &ab_c_inter );
printf( "%s: intercomm_create (%d)\n", whoami, err );
printf( "%s: barrier on inter-comm - before\n", whoami );
err = MPI_Barrier(ab_c_inter);
printf( "%s: barrier on inter-comm - after\n", whoami );
err = MPI_Intercomm_merge(ab_c_inter, 0, &abc_intra);
printf( "%s: intercomm_merge(%d) (%d) [rank %d]\n", whoami, 0, err, rank );
err = MPI_Barrier(abc_intra);
printf( "%s: barrier (%d)\n", whoami, err );
MPI_Comm_free(&abc_intra);
MPI_Comm_free(&ab_c_inter);
MPI_Comm_free(&ab_intra);
MPI_Comm_free(&ac_intra);
MPI_Comm_disconnect(&ab_inter);
MPI_Comm_disconnect(&ac_inter);
}
int main(int argc, char *argv[])
{
MPI_Status status;
MPI_Comm comm, scomm;
int a[10], b[10];
int buf[BUFSIZE], *bptr, bl, i, j, rank, size, color, errs = 0;
MTest_Init(0, 0);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
color = rank % 2;
MPI_Comm_split(MPI_COMM_WORLD, color, rank, &scomm);
MPI_Intercomm_create(scomm, 0, MPI_COMM_WORLD, 1 - color, 52, &comm);
MPI_Comm_rank(comm, &rank);
MPI_Comm_remote_size(comm, &size);
MPI_Buffer_attach(buf, BUFSIZE);
for (j = 0; j < 10; j++) {
for (i = 0; i < 10; i++) {
a[i] = (rank + 10 * j) * size + i;
}
MPI_Bsend(a, 10, MPI_INT, 0, 27 + j, comm);
}
if (rank == 0) {
for (i = 0; i < size; i++) {
for (j = 0; j < 10; j++) {
int k;
status.MPI_TAG = -10;
status.MPI_SOURCE = -20;
MPI_Recv(b, 10, MPI_INT, i, 27 + j, comm, &status);
if (status.MPI_TAG != 27 + j) {
errs++;
printf("Wrong tag = %d\n", status.MPI_TAG);
}
if (status.MPI_SOURCE != i) {
errs++;
printf("Wrong source = %d\n", status.MPI_SOURCE);
}
for (k = 0; k < 10; k++) {
if (b[k] != (i + 10 * j) * size + k) {
errs++;
printf("received b[%d] = %d from %d tag %d\n", k, b[k], i, 27 + j);
}
}
}
}
}
MPI_Buffer_detach(&bptr, &bl);
MPI_Comm_free(&scomm);
MPI_Comm_free(&comm);
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
void mpif_intercomm_create_(MPI_Fint *local_comm, int *local_leader, MPI_Fint *peer_comm, int *remote_leader, int *tag, MPI_Fint *newintercomm, int *error)
{
MPI_Comm local_comm_c = MPI_Comm_f2c(*local_comm);
MPI_Comm peer_comm_c = MPI_Comm_f2c(*peer_comm);
MPI_Comm newintercomm_c;
*error = MPI_Intercomm_create(local_comm_c, *local_leader, peer_comm_c, *remote_leader, *tag, &newintercomm_c);
*newintercomm = MPI_Comm_c2f(newintercomm_c);
}
EXPORT_MPI_API void FORTRAN_API mpi_intercomm_create_ ( MPI_Fint *local_comm, MPI_Fint *local_leader, MPI_Fint *peer_comm,
MPI_Fint *remote_leader, MPI_Fint *tag, MPI_Fint *comm_out, MPI_Fint *__ierr )
{
MPI_Comm l_comm_out;
*__ierr = MPI_Intercomm_create( MPI_Comm_f2c(*local_comm),
(int)*local_leader,
MPI_Comm_f2c(*peer_comm),
(int)*remote_leader, (int)*tag,
&l_comm_out);
*comm_out = MPI_Comm_c2f(l_comm_out);
}
int main( int argc, char *argv[] )
{
MPI_Comm intercomm;
int remote_rank, rank, size, errs = 0;
volatile int trigger;
MTest_Init( &argc, &argv );
trigger = 1;
/* while (trigger) ; */
MPI_Comm_size( MPI_COMM_WORLD, &size );
if (size < 2) {
printf( "Size must be at least 2\n" );
MPI_Abort( MPI_COMM_WORLD, 0 );
}
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
/* Make an intercomm of the first two elements of comm_world */
if (rank < 2) {
int lrank = rank, rrank = -1;
MPI_Status status;
remote_rank = 1 - rank;
MPI_Intercomm_create( MPI_COMM_SELF, 0,
MPI_COMM_WORLD, remote_rank, 27,
&intercomm );
/* Now, communicate between them */
MPI_Sendrecv( &lrank, 1, MPI_INT, 0, 13,
&rrank, 1, MPI_INT, 0, 13, intercomm, &status );
if (rrank != remote_rank) {
errs++;
printf( "%d Expected %d but received %d\n",
rank, remote_rank, rrank );
}
MPI_Comm_free( &intercomm );
}
/* The next test should create an intercomm with groups of different
sizes FIXME */
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main(int argc, char** argv) {
int myRank, nProcs;
int color, key;
int tag12 = 12, tag23 = 23, tag13 = 13;
MPI_Comm myComm, myInterComm1, myInterComm2, myInterComm3;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &myRank);
MPI_Comm_size(MPI_COMM_WORLD, &nProcs);
color = myRank % 3;
key = myRank;
MPI_Comm_split(MPI_COMM_WORLD, color, key, &myComm);
if (color == 0) {
MPI_Intercomm_create(myComm, 0, MPI_COMM_WORLD, 1, tag12, &myInterComm1);
MPI_Intercomm_create(myComm, 0, MPI_COMM_WORLD, 2, tag13, &myInterComm3);
} else if (color == 1) {
MPI_Intercomm_create(myComm, 0, MPI_COMM_WORLD, 0, tag12, &myInterComm1);
MPI_Intercomm_create(myComm, 0, MPI_COMM_WORLD, 2, tag23, &myInterComm2);
} else if (color == 2) {
MPI_Intercomm_create(myComm, 0, MPI_COMM_WORLD, 0, tag13, &myInterComm3);
MPI_Intercomm_create(myComm, 0, MPI_COMM_WORLD, 1, tag23, &myInterComm2);
}
int buf[SIZE];
interBcast(buf, SIZE, myRank, 2, color, &myInterComm3);
switch (color) {
case 0:
MPI_Comm_free(&myInterComm1);
MPI_Comm_free(&myInterComm3);
break;
case 1:
MPI_Comm_free(&myInterComm1);
MPI_Comm_free(&myInterComm2);
break;
case 2:
MPI_Comm_free(&myInterComm3);
MPI_Comm_free(&myInterComm2);
break;
}
MPI_Finalize();
return 0;
}
static void
do_parent(char *argv[], int rank, int count)
{
MPI_Comm ab_inter, ab_intra, ac_inter, ac_intra, ab_c_inter, abc_intra;
int err;
err = spawn_and_merge( argv, cmd_argv1, count, &ab_inter, &ab_intra );
err = spawn_and_merge( argv, cmd_argv2, count, &ac_inter, &ac_intra );
printf( "%s: MPI_Intercomm_create( ab_intra, 0, ac_intra, 0, %d, &inter) (%d)\n", whoami, tag, err );
err = MPI_Intercomm_create( ab_intra, 0, ac_intra, 1, tag, &ab_c_inter );
printf( "%s: intercomm_create (%d)\n", whoami, err );
err = MPI_Intercomm_merge(ab_c_inter, 0, &abc_intra);
printf( "%s: intercomm_merge(%d) (%d) [rank %d]\n", whoami, 0, err, rank );
sleep(20);
err = MPI_Barrier(abc_intra);
printf( "%s: barrier (%d)\n", whoami, err );
}
/**
* Create a child group for to the given group.
*
* @param[in] n #procs in this group (<= that in group_parent)
* @param[in] pid_list The list of proc ids (w.r.t. group_parent)
* @param[out] id_child Handle to store the created group
* @param[in] id_parent Parent group
*/
int comex_group_create(
int n, int *pid_list, comex_group_t id_parent, comex_group_t *id_child)
{
int status;
int grp_me;
comex_igroup_t *igroup_child = NULL;
MPI_Group *group_child = NULL;
MPI_Comm *comm_child = NULL;
comex_igroup_t *igroup_parent = NULL;
MPI_Group *group_parent = NULL;
MPI_Comm *comm_parent = NULL;
/* create the node in the linked list of groups and */
/* get the child's MPI_Group and MPI_Comm, to be populated shortly */
comex_create_group_and_igroup(id_child, &igroup_child);
group_child = &(igroup_child->group);
comm_child = &(igroup_child->comm);
/* get the parent's MPI_Group and MPI_Comm */
igroup_parent = comex_get_igroup_from_group(id_parent);
group_parent = &(igroup_parent->group);
comm_parent = &(igroup_parent->comm);
status = MPI_Group_incl(*group_parent, n, pid_list, group_child);
if (status != MPI_SUCCESS) {
comex_error("MPI_Group_incl: Failed ", status);
}
{
MPI_Comm comm, comm1, comm2;
int lvl=1, local_ldr_pos;
MPI_Group_rank(*group_child, &grp_me);
if (grp_me == MPI_UNDEFINED) {
*comm_child = MPI_COMM_NULL;
/* FIXME: keeping the group around for now */
return COMEX_SUCCESS;
}
/* SK: sanity check for the following bitwise operations */
assert(grp_me>=0);
MPI_Comm_dup(MPI_COMM_SELF, &comm); /* FIXME: can be optimized away */
local_ldr_pos = grp_me;
while(n>lvl) {
int tag=0;
int remote_ldr_pos = local_ldr_pos^lvl;
if (remote_ldr_pos < n) {
int remote_leader = pid_list[remote_ldr_pos];
MPI_Comm peer_comm = *comm_parent;
int high = (local_ldr_pos<remote_ldr_pos)?0:1;
MPI_Intercomm_create(
comm, 0, peer_comm, remote_leader, tag, &comm1);
MPI_Comm_free(&comm);
MPI_Intercomm_merge(comm1, high, &comm2);
MPI_Comm_free(&comm1);
comm = comm2;
}
local_ldr_pos &= ((~0)^lvl);
lvl<<=1;
}
*comm_child = comm;
/* cleanup temporary group (from MPI_Group_incl above) */
MPI_Group_free(group_child);
/* get the actual group associated with comm */
MPI_Comm_group(*comm_child, group_child);
}
return COMEX_SUCCESS;
}
/* create a loop between all the elements types */
int mpi_lsa_create_intercoms(com_lsa * com){
int prev, next,flag;
int prev_size,next_size,size;
/* create first connection between intracommunicators thanks to an intercommunicator */
/* one way */
MPI_Barrier(MPI_COMM_WORLD);
if(com->rank_world==0)printf("]> Creating intercommunicators\n-One Way :\n");
MPI_Barrier(MPI_COMM_WORLD);
printf("\t *> %d -> %d ",com->rank_world,com->master.com[4-((com->color_group)+1)]);
MPI_Barrier(MPI_COMM_WORLD);
MPI_Intercomm_create(com->com_group,0,
MPI_COMM_WORLD,com->master.com[4-((com->color_group)+1)],
com->rank_group,
&(com->inter.com[4-((com->color_group)+1)]));
MPI_Barrier(MPI_COMM_WORLD);
if(com->rank_world==0)printf("\n]> The Other : \n");
MPI_Barrier(MPI_COMM_WORLD);
printf("\t *> %d -> %d ",(com->color_group),(4-((com->color_group)-1)%4)%4);
MPI_Barrier(MPI_COMM_WORLD);
if(com->rank_world==0)printf("\n");
MPI_Barrier(MPI_COMM_WORLD);
/* the other */
MPI_Intercomm_create(com->com_group,0,
com->com_world,com->master.com[(4-((com->color_group)-1)%4)%4],
com->rank_group,
&(com->inter.com[(4-((com->color_group)-1)%4)%4]));
/// WHY THIS ????????
if((4-((com->color_group)-1)%4)%4>com->color_group){
next=(4-(com->color_group-1)%4)%4;
prev=4-((com->color_group)+1);
} else {
prev=(4-(com->color_group-1)%4)%4;
next=4-((com->color_group)+1);
}
/* set the in and out communicators */
com->out_com=com->inter.com[next];
MPI_Comm_test_inter(com->inter.com[next],&flag);
if(!flag){
mpi_lsa_print("\n\n\n\nproblem with inter.[next]\n\n\n\n\n", com);
}
com->in_com=com->inter.com[prev];
MPI_Comm_test_inter(com->inter.com[prev],&flag);
if(!flag){
mpi_lsa_print("\n\n\n\n\nproblem with inter.[prev]\n\n\n\n", com);
}
MPI_Comm_remote_size(com->out_com,&next_size);
MPI_Comm_remote_size(com->in_com,&prev_size);
MPI_Comm_size(com->com_group,&size);
if(com->color_group==0) printf("GMRES 1: my intercomm with LS %d \n",com->in_com);
if(com->rank_world==0) printf("]> In and Out communicators : \n");
MPI_Barrier(MPI_COMM_WORLD);
if(com->color_group==0) printf("GMRES : ");
else if(com->color_group==1) printf("MAIN : ");
else if(com->color_group==2) printf("ARNOLDI : ");
else if(com->color_group==3) printf("LS : ");
printf("%d: %d (%d) -> %d (%d) -> %d (%d) in_com: %d, out_com: %d\n",com->rank_world,com->master.com[prev],prev_size,com->color_group,size,com->master.com[next],next_size, com->in_com, com->out_com);
return 0;
}
int main( int argc, char *argv[] )
{
MPI_Comm splited_comm, duped_comm, inter_comm, *comm_ptr;
MPI_Request world_requests[REQUESTS_SIZE], comm_requests[REQUESTS_SIZE];
MPI_Status world_statuses[STATUSES_SIZE], comm_statuses[STATUSES_SIZE];
char processor_name[MPI_MAX_PROCESSOR_NAME];
int comm_rank, comm_size, comm_neighbor;
int world_rank, world_size, world_neighbor;
int icolor, namelen, ibuffers[REQUESTS_SIZE];
int ii, jj;
MPI_Init( &argc, &argv );
MPI_Comm_size( MPI_COMM_WORLD, &world_size );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MPI_Get_processor_name( processor_name, &namelen );
fprintf( stdout, "world_rank %d on %s\n", world_rank, processor_name );
fflush( stdout );
if ( world_rank == world_size - 1 )
world_neighbor = 0;
else
world_neighbor = world_rank + 1;
for ( ii = 0; ii < LOOP_COUNT; ii++ ) {
for ( jj = 0; jj < REQUESTS_SIZE; jj++ ) {
MPI_Irecv( &ibuffers[jj], 1, MPI_INT, MPI_ANY_SOURCE,
99, MPI_COMM_WORLD, &world_requests[jj] );
MPI_Send( &world_rank, 1, MPI_INT, world_neighbor,
99, MPI_COMM_WORLD );
}
MPI_Waitall( REQUESTS_SIZE, world_requests, world_statuses );
}
/* Split all processes into 2 separate intracommunicators */
icolor = world_rank % 2;
MPI_Comm_split( MPI_COMM_WORLD, icolor, world_rank, &splited_comm );
/* Put in a Comm_dup so local comm ID is different in 2 splited comm */
if ( icolor == 0 ) {
MPI_Comm_dup( splited_comm, &duped_comm );
comm_ptr = &duped_comm;
}
else
comm_ptr = &splited_comm;
MPI_Comm_size( *comm_ptr, &comm_size );
MPI_Comm_rank( *comm_ptr, &comm_rank );
if ( comm_rank == comm_size - 1 )
comm_neighbor = 0;
else
comm_neighbor = comm_rank + 1;
for ( ii = 0; ii < LOOP_COUNT; ii++ ) {
for ( jj = 0; jj < REQUESTS_SIZE; jj++ ) {
MPI_Irecv( &ibuffers[jj], 1, MPI_INT, MPI_ANY_SOURCE,
999, *comm_ptr, &comm_requests[jj] );
MPI_Send( &comm_rank, 1, MPI_INT, comm_neighbor,
999, *comm_ptr );
}
MPI_Waitall( REQUESTS_SIZE, comm_requests, comm_statuses );
}
/* Form an intercomm between the 2 splited intracomm's */
if ( icolor == 0 )
MPI_Intercomm_create( *comm_ptr, 0, MPI_COMM_WORLD, 1,
9090, &inter_comm );
else
MPI_Intercomm_create( *comm_ptr, 0, MPI_COMM_WORLD, 0,
9090, &inter_comm );
if ( comm_rank == 0 ) {
for ( ii = 0; ii < LOOP_COUNT; ii++ ) {
for ( jj = 0; jj < REQUESTS_SIZE; jj++ ) {
MPI_Irecv( &ibuffers[jj], 1, MPI_INT, 0,
9999, inter_comm, &comm_requests[jj] );
MPI_Send( &comm_rank, 1, MPI_INT, 0, 9999, inter_comm );
}
MPI_Waitall( REQUESTS_SIZE, comm_requests, comm_statuses );
}
}
/* Free all communicators created */
MPI_Comm_free( &inter_comm );
if ( icolor == 0 )
MPI_Comm_free( &duped_comm );
MPI_Comm_free( &splited_comm );
MPI_Finalize();
return( 0 );
}
int main(int argc, char *argv[])
{
// mpi book keeping -----------
int iproc, i, iter;
int nproc;
int number_amount;
int membershipKey;
int rank1,rank2,newSize;
int rank;
int numdim;
int pivot;
char host[255], message[55];
MPI_Status status;
MPI_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
gethostname(host,253);
switch(nproc) {
case 32: numdim = 5;break;
case 16: numdim = 4;break;
case 8: numdim = 3;break;
case 4: numdim = 2;break;
case 2: numdim = 1;break;
case 1: numdim = 0;break;
}
// -------
// each process has an array of VECSIZE double: ain[VECSIZE]
int ain[VECSIZE], *buf, *c = (int *) malloc(VECSIZE * sizeof(int));
int size = VECSIZE;
int alower[2*VECSIZE], aupper[2*VECSIZE];
int myrank, root = 0;
/* Intializes random number generator */
srand(rank+5);
double start = When();
// Distribute the items evenly to all of the nodes.
// fill with random numbers
for(i = 0; i < VECSIZE; i++) {
ain[i] = (rand()%1000)+1;
// printf("init proc %d [%d]=%d\n",myrank,i,ain[i]);
}
memcpy(c,ain,sizeof(ain));
qsort(c, size, sizeof(int), cmpfunc); // Each node sorts the items it has using quicksort.
MPI_Comm comm1 = MPI_COMM_WORLD, comm2, intercomm;
rank2 = rank ;
int lowerSize = 0 ,upperSize = 0;
int *sub_avgs = NULL;
for(int curdim = 0; curdim < numdim; curdim++ ) {
membershipKey = rank2 % 2; // creates two groups o and 1.
MPI_Comm_split(comm1, membershipKey, rank2, &comm2); // Break up the cube into two subcubes:
MPI_Comm_rank(comm2,&rank2);
if ( mediansPivot ){
// printf("meadians \n");
if (rank == 0 ){
sub_avgs =(int *) malloc(sizeof( int) * nproc);
}
pivot = median(size,c);
// printf("before gather pivot = %ld\n",pivot);
MPI_Gather(&pivot, 1, MPI_INT, sub_avgs, 1, MPI_INT, 0, MPI_COMM_WORLD);
if ( rank == 0){
// for(int i=0; i<nproc; i++)
// printf("[%d]=%ld ",i,sub_avgs[i]);
// printf("Gathered\n");
pivot = median(nproc,sub_avgs);
free(sub_avgs);
}
}
else if ( rank2 == 0 && (medianPivot || meanPivot || randomPivot)){// Node 0 broadcasts its median key K to the rest of the cube.
if (meanPivot ){
// printf("mean \n");
pivot = mean(size,c);
}
else if (medianPivot ){
// printf("meadian \n");
pivot = median(size,c);
}
else if (randomPivot ){
// printf("randomPivot \n");
int randompiv = rand()%size ;
// printf("randomindex %d \n",randompiv );
pivot = c[randompiv];
// printf("Pivot %d \n", pivot);
}
}
MPI_Bcast(&pivot,1,MPI_INT, 0, comm2);
lowerSize = 0;
upperSize = 0;
for(i = 0; i < size; i++) {// Each node separates its items into two arrays :
if (c[i] <= pivot){// keys <= K and
alower[lowerSize] = c[i];
// printf("lower [%d]=%d\n",i,alower[lowerSize]);
lowerSize ++;
}
else{// keys > K
aupper[upperSize] = c[i];
// printf("upper [%d]=%d\n",i,aupper[upperSize]);
upperSize ++;
}
}
// printf("lowerSize %d\n",lowerSize);
// printf("upperSize %d\n",upperSize);
if (membershipKey == 0 ){ // lower world (left)
MPI_Intercomm_create(comm2, 0, comm1, 1, 99, &intercomm);
// Each node in the lower subcube sends its items whose keys are > K to its adjacent node in the upper subcube
MPI_Send(aupper, upperSize, MPI_INT, rank2, 0, intercomm );
// printf("upperSize %ld ",upperSize);
// printf("worldrank %d localrank %d sending upper\n ",rank, rank2);
// for(i = 0; i < (upperSize); i++)
// printf("[%d] = %ld ", i,aupper[i]);
// printf("to otherrank %d \n ", rank2);
MPI_Probe(rank2, 0, intercomm, &status);
MPI_Get_count(&status, MPI_INT, &number_amount);
buf = (int*)malloc(sizeof(int) * number_amount);
MPI_Recv(buf, number_amount, MPI_INT, rank2, 0, intercomm, &status);
free(buf);
//Each node now merges together the group it just received
// with the one it kept so that its items are one again sorted.
free(c);
c = ARRAY_CONCAT(int, alower, lowerSize, buf,number_amount);
// printf("worldrank %d localrank %d gotsize %d\n",rank, rank2, number_amount);
size = number_amount+lowerSize;
/* for(i = 0; i < (number_amount); i++)
printf("[%d]=%ld ",i,buf[i]);
printf("\n ");
for(i = 0; i < size; i++)
printf("[%d]=%ld ",i,c[i]);
printf("\n "); */
}else{
void declareBindings (void)
{
/* === Point-to-point === */
void* buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Send (buf, count, datatype, dest, tag, comm); // L12
int source;
MPI_Status status;
MPI_Recv (buf, count, datatype, source, tag, comm, &status); // L15
MPI_Get_count (&status, datatype, &count);
MPI_Bsend (buf, count, datatype, dest, tag, comm);
MPI_Ssend (buf, count, datatype, dest, tag, comm);
MPI_Rsend (buf, count, datatype, dest, tag, comm);
void* buffer;
int size;
MPI_Buffer_attach (buffer, size); // L22
MPI_Buffer_detach (buffer, &size);
MPI_Request request;
MPI_Isend (buf, count, datatype, dest, tag, comm, &request); // L25
MPI_Ibsend (buf, count, datatype, dest, tag, comm, &request);
MPI_Issend (buf, count, datatype, dest, tag, comm, &request);
MPI_Irsend (buf, count, datatype, dest, tag, comm, &request);
MPI_Irecv (buf, count, datatype, source, tag, comm, &request);
MPI_Wait (&request, &status);
int flag;
MPI_Test (&request, &flag, &status); // L32
MPI_Request_free (&request);
MPI_Request* array_of_requests;
int index;
MPI_Waitany (count, array_of_requests, &index, &status); // L36
MPI_Testany (count, array_of_requests, &index, &flag, &status);
MPI_Status* array_of_statuses;
MPI_Waitall (count, array_of_requests, array_of_statuses); // L39
MPI_Testall (count, array_of_requests, &flag, array_of_statuses);
int incount;
int outcount;
int* array_of_indices;
MPI_Waitsome (incount, array_of_requests, &outcount, array_of_indices,
array_of_statuses); // L44--45
MPI_Testsome (incount, array_of_requests, &outcount, array_of_indices,
array_of_statuses); // L46--47
MPI_Iprobe (source, tag, comm, &flag, &status); // L48
MPI_Probe (source, tag, comm, &status);
MPI_Cancel (&request);
MPI_Test_cancelled (&status, &flag);
MPI_Send_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Bsend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Ssend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Rsend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Recv_init (buf, count, datatype, source, tag, comm, &request);
MPI_Start (&request);
MPI_Startall (count, array_of_requests);
void* sendbuf;
int sendcount;
MPI_Datatype sendtype;
int sendtag;
void* recvbuf;
int recvcount;
MPI_Datatype recvtype;
MPI_Datatype recvtag;
MPI_Sendrecv (sendbuf, sendcount, sendtype, dest, sendtag,
recvbuf, recvcount, recvtype, source, recvtag,
comm, &status); // L67--69
MPI_Sendrecv_replace (buf, count, datatype, dest, sendtag, source, recvtag,
comm, &status); // L70--71
MPI_Datatype oldtype;
MPI_Datatype newtype;
MPI_Type_contiguous (count, oldtype, &newtype); // L74
int blocklength;
{
int stride;
MPI_Type_vector (count, blocklength, stride, oldtype, &newtype); // L78
}
{
MPI_Aint stride;
MPI_Type_hvector (count, blocklength, stride, oldtype, &newtype); // L82
}
int* array_of_blocklengths;
{
int* array_of_displacements;
MPI_Type_indexed (count, array_of_blocklengths, array_of_displacements,
oldtype, &newtype); // L87--88
}
{
MPI_Aint* array_of_displacements;
MPI_Type_hindexed (count, array_of_blocklengths, array_of_displacements,
oldtype, &newtype); // L92--93
MPI_Datatype* array_of_types;
MPI_Type_struct (count, array_of_blocklengths, array_of_displacements,
array_of_types, &newtype); // L95--96
}
void* location;
MPI_Aint address;
MPI_Address (location, &address); // L100
MPI_Aint extent;
MPI_Type_extent (datatype, &extent); // L102
MPI_Type_size (datatype, &size);
MPI_Aint displacement;
MPI_Type_lb (datatype, &displacement); // L105
MPI_Type_ub (datatype, &displacement);
MPI_Type_commit (&datatype);
MPI_Type_free (&datatype);
MPI_Get_elements (&status, datatype, &count);
void* inbuf;
void* outbuf;
int outsize;
int position;
MPI_Pack (inbuf, incount, datatype, outbuf, outsize, &position, comm); // L114
int insize;
MPI_Unpack (inbuf, insize, &position, outbuf, outcount, datatype,
comm); // L116--117
MPI_Pack_size (incount, datatype, comm, &size);
/* === Collectives === */
MPI_Barrier (comm); // L121
int root;
MPI_Bcast (buffer, count, datatype, root, comm); // L123
MPI_Gather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
root, comm); // L124--125
int* recvcounts;
int* displs;
MPI_Gatherv (sendbuf, sendcount, sendtype,
recvbuf, recvcounts, displs, recvtype,
root, comm); // L128--130
MPI_Scatter (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
root, comm); // L131--132
int* sendcounts;
MPI_Scatterv (sendbuf, sendcounts, displs, sendtype,
recvbuf, recvcount, recvtype, root, comm); // L134--135
MPI_Allgather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
comm); // L136--137
MPI_Allgatherv (sendbuf, sendcount, sendtype,
recvbuf, recvcounts, displs, recvtype,
comm); // L138--140
MPI_Alltoall (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
comm); // L141--142
int* sdispls;
int* rdispls;
MPI_Alltoallv (sendbuf, sendcounts, sdispls, sendtype,
recvbuf, recvcounts, rdispls, recvtype,
comm); // L145--147
MPI_Op op;
MPI_Reduce (sendbuf, recvbuf, count, datatype, op, root, comm); // L149
#if 0
MPI_User_function function;
int commute;
MPI_Op_create (function, commute, &op); // L153
#endif
MPI_Op_free (&op); // L155
MPI_Allreduce (sendbuf, recvbuf, count, datatype, op, comm);
MPI_Reduce_scatter (sendbuf, recvbuf, recvcounts, datatype, op, comm);
MPI_Scan (sendbuf, recvbuf, count, datatype, op, comm);
/* === Groups, contexts, and communicators === */
MPI_Group group;
MPI_Group_size (group, &size); // L162
int rank;
MPI_Group_rank (group, &rank); // L164
MPI_Group group1;
int n;
int* ranks1;
MPI_Group group2;
int* ranks2;
MPI_Group_translate_ranks (group1, n, ranks1, group2, ranks2); // L170
int result;
MPI_Group_compare (group1, group2, &result); // L172
MPI_Group newgroup;
MPI_Group_union (group1, group2, &newgroup); // L174
MPI_Group_intersection (group1, group2, &newgroup);
MPI_Group_difference (group1, group2, &newgroup);
int* ranks;
MPI_Group_incl (group, n, ranks, &newgroup); // L178
MPI_Group_excl (group, n, ranks, &newgroup);
extern int ranges[][3];
MPI_Group_range_incl (group, n, ranges, &newgroup); // L181
MPI_Group_range_excl (group, n, ranges, &newgroup);
MPI_Group_free (&group);
MPI_Comm_size (comm, &size);
MPI_Comm_rank (comm, &rank);
MPI_Comm comm1;
MPI_Comm comm2;
MPI_Comm_compare (comm1, comm2, &result);
MPI_Comm newcomm;
MPI_Comm_dup (comm, &newcomm);
MPI_Comm_create (comm, group, &newcomm);
int color;
int key;
MPI_Comm_split (comm, color, key, &newcomm); // L194
MPI_Comm_free (&comm);
MPI_Comm_test_inter (comm, &flag);
MPI_Comm_remote_size (comm, &size);
MPI_Comm_remote_group (comm, &group);
MPI_Comm local_comm;
int local_leader;
MPI_Comm peer_comm;
int remote_leader;
MPI_Comm newintercomm;
MPI_Intercomm_create (local_comm, local_leader, peer_comm, remote_leader, tag,
&newintercomm); // L204--205
MPI_Comm intercomm;
MPI_Comm newintracomm;
int high;
MPI_Intercomm_merge (intercomm, high, &newintracomm); // L209
int keyval;
#if 0
MPI_Copy_function copy_fn;
MPI_Delete_function delete_fn;
void* extra_state;
MPI_Keyval_create (copy_fn, delete_fn, &keyval, extra_state); // L215
#endif
MPI_Keyval_free (&keyval); // L217
void* attribute_val;
MPI_Attr_put (comm, keyval, attribute_val); // L219
MPI_Attr_get (comm, keyval, attribute_val, &flag);
MPI_Attr_delete (comm, keyval);
/* === Environmental inquiry === */
char* name;
int resultlen;
MPI_Get_processor_name (name, &resultlen); // L226
MPI_Errhandler errhandler;
#if 0
MPI_Handler_function function;
MPI_Errhandler_create (function, &errhandler); // L230
#endif
MPI_Errhandler_set (comm, errhandler); // L232
MPI_Errhandler_get (comm, &errhandler);
MPI_Errhandler_free (&errhandler);
int errorcode;
char* string;
MPI_Error_string (errorcode, string, &resultlen); // L237
int errorclass;
MPI_Error_class (errorcode, &errorclass); // L239
MPI_Wtime ();
MPI_Wtick ();
int argc;
char** argv;
MPI_Init (&argc, &argv); // L244
MPI_Finalize ();
MPI_Initialized (&flag);
MPI_Abort (comm, errorcode);
}
/*
* Return an intercomm; set isLeftGroup to 1 if the calling process is
* a member of the "left" group.
*/
int MTestGetIntercomm(MPI_Comm * comm, int *isLeftGroup, int min_size)
{
int size, rank, remsize, merr;
int done = 0;
MPI_Comm mcomm = MPI_COMM_NULL;
MPI_Comm mcomm2 = MPI_COMM_NULL;
int rleader;
/* The while loop allows us to skip communicators that are too small.
* MPI_COMM_NULL is always considered large enough. The size is
* the sum of the sizes of the local and remote groups */
while (!done) {
*comm = MPI_COMM_NULL;
*isLeftGroup = 0;
interCommName = "MPI_COMM_NULL";
switch (interCommIdx) {
case 0:
/* Split comm world in half */
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
if (size > 1) {
merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
rleader = size / 2;
}
else if (rank == size / 2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
* designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size / 2;
merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
if (merr)
MTestPrintError(merr);
interCommName = "Intercomm by splitting MPI_COMM_WORLD";
}
else
*comm = MPI_COMM_NULL;
break;
case 1:
/* Split comm world in to 1 and the rest */
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
if (size > 1) {
merr = MPI_Comm_split(MPI_COMM_WORLD, rank == 0, rank, &mcomm);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
rleader = 1;
}
else if (rank == 1) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
* designated local leaders */
rleader = -1;
}
*isLeftGroup = rank == 0;
merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12346, comm);
if (merr)
MTestPrintError(merr);
interCommName = "Intercomm by splitting MPI_COMM_WORLD into 1, rest";
}
else
*comm = MPI_COMM_NULL;
break;
case 2:
/* Split comm world in to 2 and the rest */
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
if (size > 3) {
merr = MPI_Comm_split(MPI_COMM_WORLD, rank < 2, rank, &mcomm);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
rleader = 2;
}
else if (rank == 2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
* designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < 2;
merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12347, comm);
if (merr)
MTestPrintError(merr);
interCommName = "Intercomm by splitting MPI_COMM_WORLD into 2, rest";
}
else
*comm = MPI_COMM_NULL;
break;
case 3:
/* Split comm world in half, then dup */
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
if (size > 1) {
merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
rleader = size / 2;
}
else if (rank == size / 2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
* designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size / 2;
merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
if (merr)
MTestPrintError(merr);
/* avoid leaking after assignment below */
merr = MPI_Comm_free(&mcomm);
if (merr)
MTestPrintError(merr);
/* now dup, some bugs only occur for dup's of intercomms */
mcomm = *comm;
merr = MPI_Comm_dup(mcomm, comm);
if (merr)
MTestPrintError(merr);
interCommName = "Intercomm by splitting MPI_COMM_WORLD then dup'ing";
}
else
*comm = MPI_COMM_NULL;
break;
case 4:
/* Split comm world in half, form intercomm, then split that intercomm */
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
if (size > 1) {
merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &mcomm);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
rleader = size / 2;
}
else if (rank == size / 2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
* designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size / 2;
merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
if (merr)
MTestPrintError(merr);
/* avoid leaking after assignment below */
merr = MPI_Comm_free(&mcomm);
if (merr)
MTestPrintError(merr);
/* now split, some bugs only occur for splits of intercomms */
mcomm = *comm;
merr = MPI_Comm_rank(mcomm, &rank);
if (merr)
MTestPrintError(merr);
/* this split is effectively a dup but tests the split code paths */
merr = MPI_Comm_split(mcomm, 0, rank, comm);
if (merr)
MTestPrintError(merr);
interCommName = "Intercomm by splitting MPI_COMM_WORLD then then splitting again";
}
else
*comm = MPI_COMM_NULL;
break;
case 5:
/* split comm world in half discarding rank 0 on the "left"
* communicator, then form them into an intercommunicator */
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
if (size >= 4) {
int color = (rank < size / 2 ? 0 : 1);
if (rank == 0)
color = MPI_UNDEFINED;
merr = MPI_Comm_split(MPI_COMM_WORLD, color, rank, &mcomm);
if (merr)
MTestPrintError(merr);
if (rank == 1) {
rleader = size / 2;
}
else if (rank == (size / 2)) {
rleader = 1;
}
else {
/* Remote leader is signficant only for the processes
* designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size / 2;
if (rank != 0) { /* 0's mcomm is MPI_COMM_NULL */
merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm);
if (merr)
MTestPrintError(merr);
}
interCommName =
"Intercomm by splitting MPI_COMM_WORLD (discarding rank 0 in the left group) then MPI_Intercomm_create'ing";
}
else {
*comm = MPI_COMM_NULL;
}
break;
case 6:
/* Split comm world in half then form them into an
* intercommunicator. Then discard rank 0 from each group of the
* intercomm via MPI_Comm_create. */
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
if (size >= 4) {
MPI_Group oldgroup, newgroup;
int ranks[1];
int color = (rank < size / 2 ? 0 : 1);
merr = MPI_Comm_split(MPI_COMM_WORLD, color, rank, &mcomm);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
rleader = size / 2;
}
else if (rank == (size / 2)) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
* designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size / 2;
merr = MPI_Intercomm_create(mcomm, 0, MPI_COMM_WORLD, rleader, 12345, &mcomm2);
if (merr)
MTestPrintError(merr);
/* We have an intercomm between the two halves of comm world. Now create
* a new intercomm that removes rank 0 on each side. */
merr = MPI_Comm_group(mcomm2, &oldgroup);
if (merr)
MTestPrintError(merr);
ranks[0] = 0;
merr = MPI_Group_excl(oldgroup, 1, ranks, &newgroup);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_create(mcomm2, newgroup, comm);
if (merr)
MTestPrintError(merr);
merr = MPI_Group_free(&oldgroup);
if (merr)
MTestPrintError(merr);
merr = MPI_Group_free(&newgroup);
if (merr)
MTestPrintError(merr);
interCommName =
"Intercomm by splitting MPI_COMM_WORLD then discarding 0 ranks with MPI_Comm_create";
}
else {
*comm = MPI_COMM_NULL;
}
break;
default:
*comm = MPI_COMM_NULL;
interCommIdx = -1;
break;
}
if (*comm != MPI_COMM_NULL) {
merr = MPI_Comm_size(*comm, &size);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_remote_size(*comm, &remsize);
if (merr)
MTestPrintError(merr);
if (size + remsize >= min_size)
done = 1;
}
else {
interCommName = "MPI_COMM_NULL";
done = 1;
}
/* we are only done if all processes are done */
MPI_Allreduce(MPI_IN_PLACE, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD);
/* Advance the comm index whether we are done or not, otherwise we could
* spin forever trying to allocate a too-small communicator over and
* over again. */
interCommIdx++;
if (!done && *comm != MPI_COMM_NULL) {
/* avoid leaking communicators */
merr = MPI_Comm_free(comm);
if (merr)
MTestPrintError(merr);
}
/* cleanup for common temp objects */
if (mcomm != MPI_COMM_NULL) {
merr = MPI_Comm_free(&mcomm);
if (merr)
MTestPrintError(merr);
}
if (mcomm2 != MPI_COMM_NULL) {
merr = MPI_Comm_free(&mcomm2);
if (merr)
MTestPrintError(merr);
}
}
return interCommIdx;
}
MTEST_THREAD_RETURN_TYPE test_idup(void *arg)
{
int i;
int size, rank;
int ranges[1][3];
int rleader, isLeft;
int *excl = NULL;
int tid = *(int *) arg;
MPI_Group ingroup, high_group, even_group;
MPI_Comm local_comm, inter_comm;
MPI_Comm idupcomms[NUM_IDUPS];
MPI_Request reqs[NUM_IDUPS];
MPI_Comm outcomm;
MPI_Comm incomm = comms[tid];
MPI_Comm_size(incomm, &size);
MPI_Comm_rank(incomm, &rank);
MPI_Comm_group(incomm, &ingroup);
/* Idup incomm multiple times */
for (i = 0; i < NUM_IDUPS; i++) {
MPI_Comm_idup(incomm, &idupcomms[i], &reqs[i]);
}
/* Overlap pending idups with various comm generation functions */
/* Comm_dup */
MPI_Comm_dup(incomm, &outcomm);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_split */
MPI_Comm_split(incomm, rank % 2, size - rank, &outcomm);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create, high half of incomm */
ranges[0][0] = size / 2;
ranges[0][1] = size - 1;
ranges[0][2] = 1;
MPI_Group_range_incl(ingroup, 1, ranges, &high_group);
MPI_Comm_create(incomm, high_group, &outcomm);
MPI_Group_free(&high_group);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create_group, even ranks of incomm */
/* exclude the odd ranks */
excl = malloc((size / 2) * sizeof(int));
for (i = 0; i < size / 2; i++)
excl[i] = (2 * i) + 1;
MPI_Group_excl(ingroup, size / 2, excl, &even_group);
free(excl);
if (rank % 2 == 0) {
MPI_Comm_create_group(incomm, even_group, 0, &outcomm);
}
else {
outcomm = MPI_COMM_NULL;
}
MPI_Group_free(&even_group);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Intercomm_create & Intercomm_merge */
MPI_Comm_split(incomm, (rank < size / 2), rank, &local_comm);
if (rank == 0) {
rleader = size / 2;
}
else if (rank == size / 2) {
rleader = 0;
}
else {
rleader = -1;
}
isLeft = rank < size / 2;
MPI_Intercomm_create(local_comm, 0, incomm, rleader, 99, &inter_comm);
MPI_Intercomm_merge(inter_comm, isLeft, &outcomm);
MPI_Comm_free(&local_comm);
errs[tid] += MTestTestComm(inter_comm);
MTestFreeComm(&inter_comm);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
MPI_Waitall(NUM_IDUPS, reqs, MPI_STATUSES_IGNORE);
for (i = 0; i < NUM_IDUPS; i++) {
errs[tid] += MTestTestComm(idupcomms[i]);
MPI_Comm_free(&idupcomms[i]);
}
MPI_Group_free(&ingroup);
return NULL;
}
static void test_pair (void)
{
int prev, next, count, tag, index, i, outcount, indices[2];
int rank, size, flag, ierr, reqcount;
double send_buf[TEST_SIZE], recv_buf[TEST_SIZE];
double buffered_send_buf[TEST_SIZE * 2 + MPI_BSEND_OVERHEAD]; /* factor of two is based on guessing - only dynamic allocation would be safe */
void *buffer;
MPI_Status statuses[2];
MPI_Status status;
MPI_Request requests[2];
MPI_Comm dupcom, intercom;
#ifdef V_T
struct _VT_FuncFrameHandle {
char *name;
int func;
int frame;
};
typedef struct _VT_FuncFrameHandle VT_FuncFrameHandle_t;
VT_FuncFrameHandle_t normal_sends,
buffered_sends,
buffered_persistent_sends,
ready_sends,
sync_sends,
nblock_sends,
nblock_rsends,
nblock_ssends,
pers_sends,
pers_rsends,
pers_ssends,
sendrecv,
sendrecv_repl,
intercomm;
int classid;
VT_classdef( "Application:test_pair", &classid );
#define VT_REGION_DEF( _name, _nameframe, _class ) \
(_nameframe).name=_name; \
VT_funcdef( (_nameframe).name, _class, &((_nameframe).func) );
#define VT_BEGIN_REGION( _nameframe ) \
LOCDEF(); \
VT_begin( (_nameframe).func )
#define VT_END_REGION( _nameframe ) \
LOCDEF(); VT_end( (_nameframe).func )
#else
#define VT_REGION_DEF( _name, _nameframe, _class )
#define VT_BEGIN_REGION( _nameframe )
#define VT_END_REGION( _nameframe )
#endif
ierr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
ierr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if ( size < 2 ) {
if ( rank == 0 ) {
printf("Program needs to be run on at least 2 processes.\n");
}
ierr = MPI_Abort( MPI_COMM_WORLD, 66 );
}
ierr = MPI_Comm_dup(MPI_COMM_WORLD, &dupcom);
if ( rank >= 2 ) {
/* printf( "%d Calling finalize.\n", rank ); */
ierr = MPI_Finalize( );
exit(0);
}
next = rank + 1;
if (next >= 2)
next = 0;
prev = rank - 1;
if (prev < 0)
prev = 1;
VT_REGION_DEF( "Normal_Sends", normal_sends, classid );
VT_REGION_DEF( "Buffered_Sends", buffered_sends, classid );
VT_REGION_DEF( "Buffered_Persistent_Sends", buffered_persistent_sends, classid );
VT_REGION_DEF( "Ready_Sends", ready_sends, classid );
VT_REGION_DEF( "Sync_Sends", sync_sends, classid );
VT_REGION_DEF( "nblock_Sends", nblock_sends, classid );
VT_REGION_DEF( "nblock_RSends", nblock_rsends, classid );
VT_REGION_DEF( "nblock_SSends", nblock_ssends, classid );
VT_REGION_DEF( "Pers_Sends", pers_sends, classid );
VT_REGION_DEF( "Pers_RSends", pers_rsends, classid );
VT_REGION_DEF( "Pers_SSends", pers_ssends, classid );
VT_REGION_DEF( "SendRecv", sendrecv, classid );
VT_REGION_DEF( "SendRevc_Repl", sendrecv_repl, classid );
VT_REGION_DEF( "InterComm", intercomm, classid );
/*
* Normal sends
*/
VT_BEGIN_REGION( normal_sends );
if (rank == 0)
printf ("Send\n");
tag = 0x100;
count = TEST_SIZE / 5;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
LOCDEF();
MPI_Send(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, MPI_COMM_WORLD, &status);
msg_check(recv_buf, prev, tag, count, &status, TEST_SIZE, "send and recv");
}
else {
LOCDEF();
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE,MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,"send and recv");
init_test_data(recv_buf,TEST_SIZE,1);
MPI_Send(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
}
VT_END_REGION( normal_sends );
/*
* Buffered sends
*/
VT_BEGIN_REGION( buffered_sends );
if (rank == 0)
printf ("Buffered Send\n");
tag = 138;
count = TEST_SIZE / 5;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
LOCDEF();
MPI_Buffer_attach(buffered_send_buf, sizeof(buffered_send_buf));
MPI_Bsend(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
MPI_Buffer_detach(&buffer, &size);
if(buffer != buffered_send_buf || size != sizeof(buffered_send_buf)) {
printf ("[%d] Unexpected buffer returned by MPI_Buffer_detach(): %p/%d != %p/%d\n", rank, buffer, size, buffered_send_buf, (int)sizeof(buffered_send_buf));
MPI_Abort(MPI_COMM_WORLD, 201);
}
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, MPI_COMM_WORLD, &status);
msg_check(recv_buf, prev, tag, count, &status, TEST_SIZE, "send and recv");
}
else {
LOCDEF();
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE,MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,"send and recv");
init_test_data(recv_buf,TEST_SIZE,1);
MPI_Send(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
}
VT_END_REGION( buffered_sends );
/*
* Buffered sends
*/
VT_BEGIN_REGION( buffered_persistent_sends );
if (rank == 0)
printf ("Buffered Persistent Send\n");
tag = 238;
count = TEST_SIZE / 5;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
LOCDEF();
MPI_Buffer_attach(buffered_send_buf, sizeof(buffered_send_buf));
MPI_Bsend_init(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD, requests);
MPI_Start(requests);
MPI_Wait(requests, statuses);
MPI_Request_free(requests);
MPI_Buffer_detach(&buffer, &size);
if(buffer != buffered_send_buf || size != sizeof(buffered_send_buf)) {
printf ("[%d] Unexpected buffer returned by MPI_Buffer_detach(): %p/%d != %p/%d\n", rank, buffer, size, buffered_send_buf, (int)sizeof(buffered_send_buf));
MPI_Abort(MPI_COMM_WORLD, 201);
}
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, MPI_COMM_WORLD, &status);
msg_check(recv_buf, prev, tag, count, &status, TEST_SIZE, "send and recv");
}
else {
LOCDEF();
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE,MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,"send and recv");
init_test_data(recv_buf,TEST_SIZE,1);
MPI_Send(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
}
VT_END_REGION( buffered_persistent_sends );
/*
* Ready sends. Note that we must insure that the receive is posted
* before the rsend; this requires using Irecv.
*/
VT_BEGIN_REGION( ready_sends );
if (rank == 0)
printf ("Rsend\n");
tag = 1456;
count = TEST_SIZE / 3;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
MPI_Recv(MPI_BOTTOM, 0, MPI_INT, next, tag, MPI_COMM_WORLD, &status);
MPI_Rsend(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
MPI_Probe(MPI_ANY_SOURCE, tag, MPI_COMM_WORLD, &status);
if (status.MPI_SOURCE != prev)
printf ("Incorrect src, expected %d, got %d\n",prev, status.MPI_SOURCE);
if (status.MPI_TAG != tag)
printf ("Incorrect tag, expected %d, got %d\n",tag, status.MPI_TAG);
MPI_Get_count(&status, MPI_DOUBLE, &i);
if (i != count)
printf ("Incorrect count, expected %d, got %d\n",count,i);
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"rsend and recv");
}
else {
MPI_Irecv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, requests);
MPI_Send( MPI_BOTTOM, 0, MPI_INT, next, tag, MPI_COMM_WORLD);
MPI_Wait(requests, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"rsend and recv");
init_test_data(recv_buf,TEST_SIZE,1);
MPI_Send(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
}
VT_END_REGION( ready_sends );
/*
* Synchronous sends
*/
VT_BEGIN_REGION( sync_sends );
if (rank == 0)
printf ("Ssend\n");
tag = 1789;
count = TEST_SIZE / 3;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
MPI_Iprobe(MPI_ANY_SOURCE, tag, MPI_COMM_WORLD, &flag, &status);
if (flag)
printf ("Iprobe succeeded! source %d, tag %d\n",status.MPI_SOURCE,
status.MPI_TAG);
MPI_Ssend(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
while (!flag)
MPI_Iprobe(MPI_ANY_SOURCE, tag, MPI_COMM_WORLD, &flag, &status);
if (status.MPI_SOURCE != prev)
printf ("Incorrect src, expected %d, got %d\n",prev, status.MPI_SOURCE);
if (status.MPI_TAG != tag)
printf ("Incorrect tag, expected %d, got %d\n",tag, status.MPI_TAG);
MPI_Get_count(&status, MPI_DOUBLE, &i);
if (i != count)
printf ("Incorrect count, expected %d, got %d\n",count,i);
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE, "ssend and recv");
}
else {
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE, "ssend and recv"); init_test_data(recv_buf,TEST_SIZE,1);
MPI_Ssend(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
}
VT_END_REGION( sync_sends );
/*
* Nonblocking normal sends
*/
VT_BEGIN_REGION( nblock_sends );
if (rank == 0)
printf ("Isend\n");
tag = 2123;
count = TEST_SIZE / 5;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
MPI_Irecv(recv_buf, TEST_SIZE, MPI_DOUBLE,MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, requests);
init_test_data(send_buf,TEST_SIZE,0);
MPI_Isend(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD,
(requests+1));
MPI_Waitall(2, requests, statuses);
rq_check( requests, 2, "isend and irecv" );
msg_check(recv_buf,prev,tag,count,statuses, TEST_SIZE,"isend and irecv");
}
else {
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE,MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check(recv_buf,prev,tag,count,&status, TEST_SIZE,"isend and irecv"); init_test_data(recv_buf,TEST_SIZE,1);
MPI_Isend(recv_buf, count, MPI_DOUBLE, next, tag,MPI_COMM_WORLD,
(requests));
MPI_Wait((requests), &status);
rq_check(requests, 1, "isend (and recv)");
}
VT_END_REGION( nblock_sends );
/*
* Nonblocking ready sends
*/
VT_BEGIN_REGION( nblock_rsends );
if (rank == 0)
printf ("Irsend\n");
tag = 2456;
count = TEST_SIZE / 3;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
MPI_Irecv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, requests);
init_test_data(send_buf,TEST_SIZE,0);
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, next, 0,
MPI_BOTTOM, 0, MPI_INT, next, 0,
dupcom, &status);
MPI_Irsend(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD,
(requests+1));
reqcount = 0;
while (reqcount != 2) {
MPI_Waitany( 2, requests, &index, statuses);
if( index == 0 ) {
memcpy( &status, statuses, sizeof(status) );
}
reqcount++;
}
rq_check( requests, 1, "irsend and irecv");
msg_check(recv_buf,prev,tag,count,&status, TEST_SIZE,"irsend and irecv");
}
else {
MPI_Irecv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, requests);
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, next, 0,
MPI_BOTTOM, 0, MPI_INT, next, 0,
dupcom, &status);
flag = 0;
while (!flag)
MPI_Test(requests, &flag, &status);
rq_check( requests, 1, "irsend and irecv (test)");
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"irsend and irecv"); init_test_data(recv_buf,TEST_SIZE,1);
MPI_Irsend(recv_buf, count, MPI_DOUBLE, next, tag,
MPI_COMM_WORLD, requests);
MPI_Waitall(1, requests, statuses);
rq_check( requests, 1, "irsend and irecv");
}
VT_END_REGION( nblock_rsends );
/*
* Nonblocking synchronous sends
*/
VT_BEGIN_REGION( nblock_ssends );
if (rank == 0)
printf ("Issend\n");
tag = 2789;
count = TEST_SIZE / 3;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
MPI_Irecv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, requests );
init_test_data(send_buf,TEST_SIZE,0);
MPI_Issend(send_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD,
(requests+1));
flag = 0;
while (!flag)
MPI_Testall(2, requests, &flag, statuses);
rq_check( requests, 2, "issend and irecv (testall)");
msg_check( recv_buf, prev, tag, count, statuses, TEST_SIZE,
"issend and recv");
}
else {
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"issend and recv"); init_test_data(recv_buf,TEST_SIZE,1);
MPI_Issend(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD,requests);
flag = 0;
while (!flag)
MPI_Testany(1, requests, &index, &flag, statuses);
rq_check( requests, 1, "issend and recv (testany)");
}
VT_END_REGION( nblock_ssends );
/*
* Persistent normal sends
*/
VT_BEGIN_REGION( pers_sends );
if (rank == 0)
printf ("Send_init\n");
tag = 3123;
count = TEST_SIZE / 5;
clear_test_data(recv_buf,TEST_SIZE);
MPI_Send_init(send_buf, count, MPI_DOUBLE, next, tag,
MPI_COMM_WORLD, requests);
MPI_Recv_init(recv_buf, TEST_SIZE, MPI_DOUBLE,MPI_ANY_SOURCE, MPI_ANY_TAG,
MPI_COMM_WORLD, (requests+1));
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
MPI_Startall(2, requests);
MPI_Waitall(2, requests, statuses);
msg_check( recv_buf, prev, tag, count, (statuses+1),
TEST_SIZE, "persistent send/recv");
}
else {
MPI_Start((requests+1));
MPI_Wait((requests+1), &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"persistent send/recv");
init_test_data(send_buf,TEST_SIZE,1);
MPI_Start(requests);
MPI_Wait(requests, &status);
}
MPI_Request_free(requests);
MPI_Request_free((requests+1));
VT_END_REGION( pers_sends );
/*
* Persistent ready sends
*/
VT_BEGIN_REGION( pers_rsends );
if (rank == 0)
printf ("Rsend_init\n");
tag = 3456;
count = TEST_SIZE / 3;
clear_test_data(recv_buf,TEST_SIZE);
MPI_Rsend_init(send_buf, count, MPI_DOUBLE, next, tag,
MPI_COMM_WORLD, requests);
MPI_Recv_init(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, MPI_COMM_WORLD, (requests+1));
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0); MPI_Barrier( MPI_COMM_WORLD );
MPI_Startall(2, requests);
reqcount = 0;
while (reqcount != 2) {
MPI_Waitsome(2, requests, &outcount, indices, statuses);
for (i=0; i<outcount; i++) {
if (indices[i] == 1) {
msg_check( recv_buf, prev, tag, count, (statuses+i),
TEST_SIZE, "waitsome");
}
reqcount++;
}
}
}
else {
MPI_Start((requests+1)); MPI_Barrier( MPI_COMM_WORLD );
flag = 0;
while (!flag)
MPI_Test((requests+1), &flag, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE, "test");
init_test_data(send_buf,TEST_SIZE,1);
MPI_Start(requests);
MPI_Wait(requests, &status);
}
MPI_Request_free(requests);
MPI_Request_free((requests+1));
VT_END_REGION( pers_rsends );
/*
* Persistent synchronous sends
*/
VT_BEGIN_REGION( pers_ssends );
if (rank == 0)
printf ("Ssend_init\n");
tag = 3789;
count = TEST_SIZE / 3;
clear_test_data(recv_buf,TEST_SIZE);
MPI_Ssend_init(send_buf, count, MPI_DOUBLE, next, tag,
MPI_COMM_WORLD, (requests+1));
MPI_Recv_init(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, MPI_COMM_WORLD, requests);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
MPI_Startall(2, requests);
reqcount = 0;
while (reqcount != 2) {
MPI_Testsome(2, requests, &outcount, indices, statuses);
for (i=0; i<outcount; i++) {
if (indices[i] == 0) {
msg_check( recv_buf, prev, tag, count, (statuses+i),
TEST_SIZE, "testsome");
}
reqcount++;
}
}
}
else {
MPI_Start(requests);
flag = 0;
while (!flag)
MPI_Testany(1, requests, &index, &flag, statuses);
msg_check( recv_buf, prev, tag, count, statuses, TEST_SIZE, "testany" );
init_test_data(send_buf,TEST_SIZE,1);
MPI_Start((requests+1));
MPI_Wait((requests+1), &status);
}
MPI_Request_free(requests);
MPI_Request_free((requests+1));
VT_END_REGION( pers_ssends );
/*
* Send/receive.
*/
VT_BEGIN_REGION( sendrecv );
if (rank == 0)
printf ("Sendrecv\n");
tag = 4123;
count = TEST_SIZE / 5;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
MPI_Sendrecv(send_buf, count, MPI_DOUBLE, next, tag,
recv_buf, count, MPI_DOUBLE, prev, tag,
MPI_COMM_WORLD, &status );
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"sendrecv");
}
else {
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"recv/send"); init_test_data(recv_buf,TEST_SIZE,1);
MPI_Send(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
}
VT_END_REGION( sendrecv );
#ifdef V_T
VT_flush();
#endif
/*
* Send/receive replace.
*/
VT_BEGIN_REGION( sendrecv_repl );
if (rank == 0)
printf ("Sendrecv_replace\n");
tag = 4456;
count = TEST_SIZE / 3;
if (rank == 0) {
init_test_data(recv_buf, TEST_SIZE,0);
for (i=count; i< TEST_SIZE; i++)
recv_buf[i] = 0.0;
MPI_Sendrecv_replace(recv_buf, count, MPI_DOUBLE,
next, tag, prev, tag, MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"sendrecvreplace");
}
else {
clear_test_data(recv_buf,TEST_SIZE);
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, MPI_COMM_WORLD, &status);
msg_check( recv_buf, prev, tag, count, &status, TEST_SIZE,
"recv/send for replace"); init_test_data(recv_buf,TEST_SIZE,1);
MPI_Send(recv_buf, count, MPI_DOUBLE, next, tag, MPI_COMM_WORLD);
}
VT_END_REGION( sendrecv_repl );
/*
* Send/Receive via inter-communicator
*/
VT_BEGIN_REGION( intercomm );
MPI_Intercomm_create(MPI_COMM_SELF, 0, MPI_COMM_WORLD, next, 1, &intercom);
if (rank == 0)
printf ("Send via inter-communicator\n");
tag = 4018;
count = TEST_SIZE / 5;
clear_test_data(recv_buf,TEST_SIZE);
if (rank == 0) {
init_test_data(send_buf,TEST_SIZE,0);
LOCDEF();
MPI_Send(send_buf, count, MPI_DOUBLE, 0, tag, intercom);
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE, MPI_ANY_SOURCE,
MPI_ANY_TAG, intercom, &status);
msg_check(recv_buf, 0, tag, count, &status, TEST_SIZE, "send and recv via inter-communicator");
}
else if (rank == 1) {
LOCDEF();
MPI_Recv(recv_buf, TEST_SIZE, MPI_DOUBLE,MPI_ANY_SOURCE, MPI_ANY_TAG,
intercom, &status);
msg_check( recv_buf, 0, tag, count, &status, TEST_SIZE,"send and recv via inter-communicator");
init_test_data(recv_buf,TEST_SIZE,0);
MPI_Send(recv_buf, count, MPI_DOUBLE, 0, tag, intercom);
}
VT_END_REGION( normal_sends );
MPI_Comm_free(&intercom);
MPI_Comm_free(&dupcom);
}
int main(int argc, char **argv)
{
int i, j, k;
double start, end;
/* Time array */
double time[9];
double comm_time = 0;
double comp_time = 0;
int chunkSize;
MPI_Status status;
/* Being used in FFT */
float data[N][N];
/* Being used in mm */
float input_1[N][N], input_2[N][N];
/* Local matrix for FFT */
float local_data[N][N];
/* World rank and processor, related to MPI_COMM_WORLD */
int world_id;
int world_processor;
/* Divided rank and processors for communication, related to taskcomm */
int task_id;
int task_processor;
/* A complex array storing the temp row to operate FFT */
complex temp_data[N];
/* Initialize rank and the number of processor for the MPI */
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &world_id);
MPI_Comm_size(MPI_COMM_WORLD, &world_processor);
/* Initialize a new vector for distributing columns */
MPI_Datatype column, col;
/* Column vector */
MPI_Type_vector(N, 1, N, MPI_FLOAT, &col);
MPI_Type_commit(&col);
MPI_Type_create_resized(col, 0, 1*sizeof(float), &column);
MPI_Type_commit(&column);
int task = world_id%4;
MPI_Comm taskcomm;
/* Split the MPI_COMM_WORLD */
MPI_Comm_split(MPI_COMM_WORLD, task, world_id, &taskcomm);
MPI_Comm_rank(taskcomm, &task_id);
MPI_Comm_size(taskcomm, &task_processor);
/* Initialize inter communicators */
MPI_Comm t1_t3_comm, t2_t3_comm, t3_t4_comm;
/* Calculate chunkSize */
chunkSize = N/task_processor;
/* Get the start time of all program */
if(world_id == 0){
printf("2D convolution using MPI task and data parallelism\n");
start = MPI_Wtime();
}
/* Each group completes work and send results by inter communicators */
if(task == 0){
// task 1
/* Create an inter communicator for task 1 and task 3 */
MPI_Intercomm_create(taskcomm, 0, MPI_COMM_WORLD, 2, 1, &t1_t3_comm);
if(task_id == 0){
time[0] = MPI_Wtime();
/* Read file */
readIm1File(data);
time[1] = MPI_Wtime();
printf("Group 1: Reading file 1_im1 takes %f s.\n", time[1] - time[0]);
}
/* Scatter data to local ranks */
MPI_Scatter(data, chunkSize*N, MPI_FLOAT,
local_data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
/* Compute time for distributing data */
if(task_id == 0){
time[2] = MPI_Wtime();
printf("Group 1: Scattering 1_im1(row) to each processor takes %f s.\n", time[2] - time[1]);
}
/* Do 1_im1 2d FFT */
/* Row FFT */
for(i = 0; i < chunkSize; i++){
for(j = 0; j < N; j++){
/* FFT each row for im1 */
temp_data[j].r = local_data[i][j];
temp_data[j].i = 0;
}
c_fft1d(temp_data, N, -1);
for(j = 0; j < N; j++)
local_data[i][j] = temp_data[j].r;
}
/* Gather all the data and distribute in columns */
if(task_id == 0){
time[3] = MPI_Wtime();
printf("Group 1: FFT each row for 1_im1 takes %f s.\n", time[3] - time[2]);
}
/* Gather all the data of 1_im1 */
MPI_Gather(local_data, chunkSize*N, MPI_FLOAT,
data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
if(task_id == 0){
time[4] = MPI_Wtime();
printf("Group 1: Gathering all the data of 1_im1(row) takes %f s.\n", time[4] - time[3]);
}
/* Scatter all the data to column local data */
MPI_Scatter(data, chunkSize, column,
local_data, chunkSize, column,
0, taskcomm);
if(task_id == 0){
time[5] = MPI_Wtime();
printf("Group 1: Scattering 1_im1(column) to each processor takes %f s.\n", time[5] - time[4]);
}
/* Column FFT */
for(i = 0; i < chunkSize; i++){
for(j = 0; j < N; j++){
/* FFT each column for im1 */
temp_data[j].r = local_data[j][i];
temp_data[j].i = 0;
}
c_fft1d(temp_data, N, -1);
for(j = 0; j < N; j++)
local_data[j][i] = temp_data[j].r;
}
/* Gather all the columns from each rank */
if(task_id == 0){
time[6] = MPI_Wtime();
printf("Group 1: FFT each column for 1_im1 takes %f s.\n", time[6] - time[5]);
}
MPI_Gather(local_data, chunkSize, column,
data, chunkSize, column,
0, taskcomm);
/* Compute time and distribute data to do matrix multiplication */
if(task_id == 0){
time[7] = MPI_Wtime();
printf("Group 1: Gathering all the data of 1_im1(column) takes %f s.\n", time[7] - time[6]);
/* Total time */
printf("Group 1: Total time for task 1 in group 1 takes %f s.\n", time[7] - time[0]);
comm_time += time[7] - time[6] + time[5] - time[3] + time[2] - time[1];
comp_time += time[6] - time[5] + time[3] - time[2];
/* Send data to group 3 via the inter communicator */
MPI_Send(data, N*N, MPI_FLOAT, task_id, 13, t1_t3_comm);
}
}
else if(task == 1){
// Task 2
/* Create an inter communicator for task 2 and task 3 */
MPI_Intercomm_create(taskcomm, 0, MPI_COMM_WORLD, 2, 2, &t2_t3_comm);
if(task_id == 0){
time[0] = MPI_Wtime();
/* Read file */
readIm2File(data);
time[1] = MPI_Wtime();
printf("Group 2: Reading file 1_im2 takes %f s.\n", time[1] - time[0]);
}
/* Scatter data to local ranks */
MPI_Scatter(data, chunkSize*N, MPI_FLOAT,
local_data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
/* Compute time for distributing data */
if(task_id == 0){
time[2] = MPI_Wtime();
printf("Group 2: Scatter 1_im2(row) to each processor takes %f s.\n", time[2] - time[1]);
}
/* Do 1_im1 2d FFT */
/* Row FFT */
for(i = 0; i < chunkSize; i++){
for(j = 0; j < N; j++){
/* FFT each row for im1 */
temp_data[j].r = local_data[i][j];
temp_data[j].i = 0;
}
c_fft1d(temp_data, N, -1);
for(j = 0; j < N; j++)
local_data[i][j] = temp_data[j].r;
}
/* Gather all the data and distribute in columns */
if(task_id == 0){
time[3] = MPI_Wtime();
printf("Group 2: FFT each row for 1_im2 takes %f s.\n", time[3] - time[2]);
}
/* Gather all the data of 1_im1 */
MPI_Gather(local_data, chunkSize*N, MPI_FLOAT,
data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
if(task_id == 0){
time[4] = MPI_Wtime();
printf("Group 2: Gather all the data of 1_im2(row) takes %f s.\n", time[4] - time[3]);
}
/* Scatter all the data to column local data */
MPI_Scatter(data, chunkSize, column,
local_data, chunkSize, column,
0, taskcomm);
if(task_id == 0){
time[5] = MPI_Wtime();
printf("Group 2: Scatter 1_im2(column) to each processor takes %f s.\n", time[5] - time[4]);
}
/* Column FFT */
for(i = 0; i < chunkSize; i++){
for(j = 0; j < N; j++){
/* FFT each column for im1 */
temp_data[j].r = local_data[j][i];
temp_data[j].i = 0;
}
c_fft1d(temp_data, N, -1);
for(j = 0; j < N; j++)
local_data[j][i] = temp_data[j].r;
}
/* Gather all the columns from each rank */
if(task_id == 0){
time[6] = MPI_Wtime();
printf("Group 2: FFT each column for 1_im2 takes %f s.\n", time[6] - time[5]);
}
MPI_Gather(local_data, chunkSize, column,
data, chunkSize, column,
0, taskcomm);
/* Compute time and distribute data to do matrix multiplication */
if(task_id == 0){
time[7] = MPI_Wtime();
printf("Group 2: Gather all the data of 1_im2(column) takes %f s.\n", time[7] - time[6]);
/* Total time */
printf("Group 2: Total time for task 2 in group 2 takes %f s.\n", time[7] - time[0]);
comm_time += time[7] - time[6] + time[5] - time[3] + time[2] - time[1];
comp_time += time[6] - time[5] + time[3] - time[2];
/* Send data to group 3 via the inter communicator */
MPI_Send(data, N*N, MPI_FLOAT, task_id, 23, t2_t3_comm);
}
}
else if(task == 2){
// Task 3
/* Local matrix for matrix multiplication */
float local_data2[chunkSize][N];
/* Create inter communicators for task 1 and task3, task 2 and task 3, task 3 and task 4 */
MPI_Intercomm_create(taskcomm, 0, MPI_COMM_WORLD, 0, 1, &t1_t3_comm);
MPI_Intercomm_create(taskcomm, 0, MPI_COMM_WORLD, 1, 2, &t2_t3_comm);
MPI_Intercomm_create(taskcomm, 0, MPI_COMM_WORLD, 3, 3, &t3_t4_comm);
/* Receive data from group 1 and group 2 */
if(task_id == 0){
time[0] = MPI_Wtime();
MPI_Recv(input_1, N*N, MPI_FLOAT, task_id, 13, t1_t3_comm, &status);
MPI_Recv(input_2, N*N, MPI_FLOAT, task_id, 23, t2_t3_comm, &status);
time[1] = MPI_Wtime();
/* Time of receiving data from group 1 and group 2 */
printf("Group 3: Receiving data from group 1 and group 2 takes %f s.\n", time[1] - time[0]);
}
/* Do matrix multiplication */
MPI_Scatter(input_1, chunkSize*N, MPI_FLOAT,
local_data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
/* Broadcast data2 to all the ranks */
MPI_Bcast(input_2, N*N, MPI_FLOAT, 0, taskcomm);
if(task_id == 0){
time[2] = MPI_Wtime();
printf("Group 3: Scattering data for multiplication takes %f s.\n", time[2] - time[1]);
}
/* Matrix multiplication */
for(i = 0; i < chunkSize; i++)
for(j = 0; j < N; j++){
local_data2[i][j] = 0;
for(k = 0; k < N; k++)
local_data2[i][j] += local_data[i][k]*input_2[k][j];
}
/* Collect multiplication result from each rank */
if(task_id == 0){
time[3] = MPI_Wtime();
printf("Group 3: Matrix multiplication takes %f s.\n", time[3] - time[2]);
}
/* Gather data */
MPI_Gather(local_data2, chunkSize*N, MPI_FLOAT,
data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
if(task_id == 0){
time[4] = MPI_Wtime();
printf("Group 3: Gathering data after Matrix multiplication takes %f s.\n", time[4] - time[3]);
/* total time */
printf("Group 3: Total time for task 3 in group 3 takes %f s.\n", time[4] - time[0]);
/* send result of matrix multiplication to group 4 */
MPI_Send(data, N*N, MPI_FLOAT, task_id, 34, t3_t4_comm);
}
comm_time += time[4] - time[3] + time[2] - time[0];
comp_time += time[3] - time[2];
MPI_Comm_free(&t1_t3_comm);
MPI_Comm_free(&t2_t3_comm);
}
else{
// Task 4
/* Create an inter communicator for task 3 and task 4 */
MPI_Intercomm_create(taskcomm, 0, MPI_COMM_WORLD, 2, 3, &t3_t4_comm);
/* Receive data from group 3 */
if(task_id == 0){
time[0] = MPI_Wtime();
MPI_Recv(data, N*N, MPI_FLOAT, task_id, 34, t3_t4_comm, &status);
time[1] = MPI_Wtime();
printf("Group 4: Receiving data from group 3 takes %f s.\n", time[1] - time[0]);
}
/* Scatter data to each processor */
MPI_Scatter(data, chunkSize*N, MPI_FLOAT,
local_data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
if(task_id == 0){
time[2] = MPI_Wtime();
printf("Group 4: Scattering data of rows to each processor takes %f s.\n", time[2] - time[1]);
}
/* Inverse-2DFFT(row) */
for(i = 0; i < chunkSize; i++){
for(j = 0; j < N; j++){
/* FFT each row for im1 */
temp_data[j].r = local_data[i][j];
temp_data[j].i = 0;
}
c_fft1d(temp_data, N, 1);
for(j = 0; j < N; j++)
local_data[i][j] = temp_data[j].r;
}
if(task_id == 0){
time[3] = MPI_Wtime();
printf("Group 4: Inverse-2DFFT(row) takes %f s.\n", time[3] - time[2]);
}
/* Gather all the data */
MPI_Gather(local_data, chunkSize*N, MPI_FLOAT,
data, chunkSize*N, MPI_FLOAT,
0, taskcomm);
if(task_id == 0){
time[4] = MPI_Wtime();
printf("Group 4: Gathering data of Inverse-2DFFT(row) takes %f s.\n", time[4] - time[3]);
}
MPI_Scatter(data, chunkSize, column,
local_data, chunkSize, column,
0, taskcomm);
if(task_id == 0){
time[5] = MPI_Wtime();
printf("Group 4: Scattering data of columns to each processor takes %f s.\n", time[5] - time[4]);
}
/* Inverse-2DFFT(column) for output file */
for(i = 0; i < chunkSize; i++){
for(j = 0; j < N; j++){
/* FFT each column for im1 */
temp_data[j].r = local_data[j][i];
temp_data[j].i = 0;
}
c_fft1d(temp_data, N, 1);
for(j = 0; j < N; j++)
local_data[j][i] = temp_data[j].r;
}
if(task_id == 0){
time[6] = MPI_Wtime();
printf("Group 4: Inverse-2DFFT(column) takes %f s.\n", time[6] - time[5]);
}
/* Gather all the columns of output file from each rank */
MPI_Gather(local_data, chunkSize, column,
data, chunkSize, column,
0, taskcomm);
if(task_id == 0){
time[7] = MPI_Wtime();
printf("Group 4: Gathering data of Inverse-2DFFT(column) takes %f s.\n", time[7] - time[6]);
writeFile(data);
time[8] = MPI_Wtime();
printf("Group 4: Writing file to out_1 takes %f s.\n", time[8] - time[7]);
comm_time += time[7] - time[6] + time[5] - time[3] + time[2] - time[0];
comp_time += time[6] - time[5] + time[3] - time[2];
}
MPI_Comm_free(&t3_t4_comm);
}
MPI_Barrier(MPI_COMM_WORLD);
if(world_id == 0){
end = MPI_Wtime();
printf("Total communication time of 2D convolution using MPI task parallel takes %f s.\n", comm_time);
printf("Total computing time of 2D convolution using MPI task parallel takes %f s.\n", comp_time);
printf("Total running time without loading/writing of 2D convolution using MPI task parallel takes %f s.\n", comm_time + comp_time);
printf("Total running time of 2D convolution using MPI task parallel takes %f s.\n", end - start);
}
/* Free vector and task comm */
MPI_Type_free(&column);
MPI_Type_free(&col);
MPI_Comm_free(&taskcomm);
MPI_Finalize();
return 0;
}
int
main (int argc, char **argv)
{
int nprocs = -1;
int rank = -1;
char processor_name[128];
int namelen = 128;
int buf0[buf_size];
int buf1[buf_size];
MPI_Status status;
MPI_Comm temp, intercomm;
int trank, tnprocs;
int drank, dnprocs, rleader, rnprocs;
/* init */
MPI_Init (&argc, &argv);
MPI_Comm_size (MPI_COMM_WORLD, &nprocs);
MPI_Comm_rank (MPI_COMM_WORLD, &rank);
MPI_Get_processor_name (processor_name, &namelen);
printf ("(%d) is alive on %s\n", rank, processor_name);
fflush (stdout);
MPI_Barrier (MPI_COMM_WORLD);
if (nprocs < 4) {
printf ("not enough tasks\n");
}
else {
/* need to make split communicator temporarily... */
MPI_Comm_split (MPI_COMM_WORLD, rank % 2, nprocs - rank, &temp);
if (temp != MPI_COMM_NULL) {
MPI_Comm_size (temp, &tnprocs);
MPI_Comm_rank (temp, &trank);
/* create an intercommunicator temporarily so can merge it... */
rleader = ((rank + nprocs) % 2) ? nprocs - 2 : nprocs - 1;
if (rank == 1) {
MPI_Recv (buf0, buf_size, MPI_INT, 0, 0, MPI_COMM_WORLD, &status);
}
MPI_Intercomm_create (temp, 0, MPI_COMM_WORLD, rleader,
INTERCOMM_CREATE_TAG, &intercomm);
if (rank == 0) {
memset (buf0, 0, buf_size);
MPI_Send (buf0, buf_size, MPI_INT, 1, 0, MPI_COMM_WORLD);
}
MPI_Comm_free (&temp);
if (intercomm != MPI_COMM_NULL) {
MPI_Comm_size (intercomm, &dnprocs);
MPI_Comm_rank (intercomm, &drank);
MPI_Comm_remote_size (intercomm, &rnprocs);
if (rnprocs > drank) {
if (rank % 2) {
memset (buf1, 1, buf_size);
MPI_Recv (buf0, buf_size, MPI_INT, drank, 0, intercomm, &status);
MPI_Send (buf1, buf_size, MPI_INT, drank, 0, intercomm);
}
else {
memset (buf0, 0, buf_size);
MPI_Send (buf0, buf_size, MPI_INT, drank, 0, intercomm);
MPI_Recv (buf1, buf_size, MPI_INT, drank, 0, intercomm, &status);
}
}
else {
printf ("(%d) Intercomm too small (lrank = %d; remote size = %d)\n",
rank, drank, rnprocs);
}
MPI_Comm_free (&intercomm);
}
else {
printf ("(%d) Got MPI_COMM_NULL\n", rank);
}
}
else {
printf ("(%d) MPI_Comm_split got MPI_COMM_NULL\n", rank);
}
}
MPI_Barrier (MPI_COMM_WORLD);
MPI_Finalize ();
printf ("(%d) Finished normally\n", rank);
}
int main(int argc, char **argv)
{
MPI_Comm c0, c1, ic;
MPI_Group g0, g1, gworld;
int a, b, c, d;
int rank, size, remote_leader, tag;
int ranks[2];
int errs = 0;
tag = 5;
c0 = c1 = ic = MPI_COMM_NULL;
g0 = g1 = gworld = MPI_GROUP_NULL;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
if (size < 33) {
printf("ERROR: this test requires at least 33 processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
exit(1);
}
/* group of c0
* NOTE: a>=32 is essential for exercising the loop bounds bug from tt#1574 */
a = 32;
b = 24;
/* group of c1 */
c = 25;
d = 26;
MPI_Comm_group(MPI_COMM_WORLD, &gworld);
ranks[0] = a;
ranks[1] = b;
MPI_Group_incl(gworld, 2, ranks, &g0);
MPI_Comm_create(MPI_COMM_WORLD, g0, &c0);
ranks[0] = c;
ranks[1] = d;
MPI_Group_incl(gworld, 2, ranks, &g1);
MPI_Comm_create(MPI_COMM_WORLD, g1, &c1);
if (rank == a || rank == b) {
remote_leader = c;
MPI_Intercomm_create(c0, 0, MPI_COMM_WORLD, remote_leader, tag, &ic);
}
else if (rank == c || rank == d) {
remote_leader = a;
MPI_Intercomm_create(c1, 0, MPI_COMM_WORLD, remote_leader, tag, &ic);
}
MPI_Group_free(&g0);
MPI_Group_free(&g1);
MPI_Group_free(&gworld);
if (c0 != MPI_COMM_NULL)
MPI_Comm_free(&c0);
if (c1 != MPI_COMM_NULL)
MPI_Comm_free(&c1);
if (ic != MPI_COMM_NULL)
MPI_Comm_free(&ic);
MPI_Reduce((rank == 0 ? MPI_IN_PLACE : &errs), &errs,
1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
if (rank == 0) {
if (errs) {
printf("found %d errors\n", errs);
}
else {
printf(" No errors\n");
}
}
MPI_Finalize();
return 0;
}
int main( int argc, char **argv )
{
int size, rank, key, his_key, lrank, result;
MPI_Comm myComm;
MPI_Comm myFirstComm;
MPI_Comm mySecondComm;
int errors = 0, sum_errors;
MPI_Status status;
/* Initialization */
MPI_Init ( &argc, &argv );
MPI_Comm_rank ( MPI_COMM_WORLD, &rank);
if (verbose) printf("[%d] MPI_Init complete!\n",rank);fflush(stdout);
MPI_Comm_size ( MPI_COMM_WORLD, &size);
/* Only works for 2 or more processes */
if (size >= 2) {
MPI_Comm merge1, merge2, merge3, merge4;
/* Generate membership key in the range [0,1] */
key = rank % 2;
MPI_Comm_split ( MPI_COMM_WORLD, key, rank, &myComm );
/* This creates an intercomm that is the size of comm world
but has processes grouped by even and odd */
MPI_Intercomm_create (myComm, 0, MPI_COMM_WORLD, (key+1)%2, 1,
&myFirstComm );
/* Dup an intercomm */
MPI_Comm_dup ( myFirstComm, &mySecondComm );
MPI_Comm_rank( mySecondComm, &lrank );
his_key = -1;
if (verbose) printf("[%d] Communicators created!\n",rank);fflush(stdout);
/* Leaders communicate with each other */
if (lrank == 0) {
MPI_Sendrecv (&key, 1, MPI_INT, 0, 0,
&his_key, 1, MPI_INT, 0, 0, mySecondComm, &status);
if (key != (his_key+1)%2) {
printf( "Received %d but expected %d\n", his_key, (his_key+1)%2 );
errors++;
}
}
if (verbose) printf("[%d] MPI_Sendrecv completed!\n",rank);fflush(stdout);
if (errors)
printf("[%d] Failed!\n",rank);
if (verbose) printf( "About to merge intercommunicators\n" );fflush(stdout);
MPI_Intercomm_merge ( mySecondComm, key, &merge1 );
if (verbose) printf( "merge1 done\n" );fflush(stdout);
MPI_Intercomm_merge ( mySecondComm, (key+1)%2, &merge2 );
if (verbose) printf( "merge2 done\n" );fflush(stdout);
MPI_Intercomm_merge ( mySecondComm, 0, &merge3 );
if (verbose) printf( "merge3 done\n" );fflush(stdout);
MPI_Intercomm_merge ( mySecondComm, 1, &merge4 );
if (verbose) printf( "merge4 done\n" );fflush(stdout);
if (verbose) printf("[%d] MPI_Intercomm_merge completed!\n",rank);fflush(stdout);
/* We should check that these are correct! An easy test is that
the merged comms are all MPI_SIMILAR (unless 2 processes used,
in which case MPI_CONGRUENT is ok */
MPI_Comm_compare( merge1, MPI_COMM_WORLD, &result );
if ((size > 2 && result != MPI_SIMILAR) ||
(size == 2 && result != MPI_CONGRUENT)) {
errors ++;
printf( "merge1 is not the same size as comm world\n" );
}
/* merge 2 isn't ordered the same way as the others, even for 2 processes */
MPI_Comm_compare( merge2, MPI_COMM_WORLD, &result );
if (result != MPI_SIMILAR) {
errors ++;
printf( "merge2 is not the same size as comm world\n" );
}
MPI_Comm_compare( merge3, MPI_COMM_WORLD, &result );
if ((size > 2 && result != MPI_SIMILAR) ||
(size == 2 && result != MPI_CONGRUENT)) {
errors ++;
printf( "merge3 is not the same size as comm world\n" );
}
MPI_Comm_compare( merge4, MPI_COMM_WORLD, &result );
if ((size > 2 && result != MPI_SIMILAR) ||
(size == 2 && result != MPI_CONGRUENT)) {
errors ++;
printf( "merge4 is not the same size as comm world\n" );
}
if (verbose) printf("[%d] MPI_Comm_compare completed!\n",rank);fflush(stdout);
/* Free communicators */
if (verbose) printf( "About to free communicators\n" );
MPI_Comm_free( &myComm );
MPI_Comm_free( &myFirstComm );
MPI_Comm_free( &mySecondComm );
MPI_Comm_free( &merge1 );
MPI_Comm_free( &merge2 );
MPI_Comm_free( &merge3 );
MPI_Comm_free( &merge4 );
if (verbose) printf("[%d] MPI_Comm_free completed!\n",rank);fflush(stdout);
}
else {
errors ++;
printf("[%d] Failed - at least 2 nodes must be used\n",rank);
}
MPI_Barrier( MPI_COMM_WORLD );
MPI_Allreduce( &errors, &sum_errors, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (sum_errors > 0) {
printf( "%d errors on process %d\n", errors, rank );
}
else if (rank == 0) {
printf( " No Errors\n" );
}
/* Finalize and end! */
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
int i, j;
int high;
int leader;
int buffer[3];
int errcodes[2];
int world_rank;
int world_size;
int merge_rank;
int merge_size;
int inter_rank;
int inter_rem_size;
int inter_loc_size;
int univ_rank;
int univ_size;
MPI_Comm parent_comm = MPI_COMM_NULL;
MPI_Comm spawn_comm = MPI_COMM_NULL;
MPI_Comm merge_comm = MPI_COMM_NULL;
MPI_Comm peer_comm = MPI_COMM_NULL;
MPI_Comm inter_comm = MPI_COMM_NULL;
MPI_Comm univ_comm = MPI_COMM_NULL;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &world_rank);
MPI_Comm_size(MPI_COMM_WORLD, &world_size);
if(world_size != 2) {
printf("This program needs exactly np = 2 processes! Calling MPI_Abort()...\n");
MPI_Abort(MPI_COMM_WORLD, -1);
}
MPI_Comm_get_parent( &parent_comm );
if(parent_comm == MPI_COMM_NULL) {
MPI_Comm_spawn((char*)"./spawn_univ_comm", MPI_ARGV_NULL, 2, MPI_INFO_NULL, 0, MPI_COMM_SELF, &spawn_comm, errcodes);
} else {
spawn_comm = parent_comm;
}
if(parent_comm == MPI_COMM_NULL) {
high = 1;
}
else {
high = 0;
}
/* Merge each intercomm between the spawned groups into an intracomm: */
MPI_Intercomm_merge(spawn_comm, high, &merge_comm);
MPI_Comm_rank(merge_comm, &merge_rank);
MPI_Comm_size(merge_comm, &merge_size);
/* Determine the leader (rank 0 & 1 of the origin world): */
if(parent_comm == MPI_COMM_NULL) leader = merge_rank;
else leader = -1;
MPI_Allgather(&leader, 1, MPI_INT, buffer, 1, MPI_INT, merge_comm);
for(i=0; i<merge_size; i++) {
if(buffer[i] != -1) {
leader = i;
break;
}
}
/* Create an intercomm between the two merged intracomms (and use the origin world as bridge/peer communicator): */
peer_comm = MPI_COMM_WORLD;
MPI_Intercomm_create(merge_comm, leader, peer_comm, (world_rank+1)%2, 123, &inter_comm);
MPI_Comm_rank(inter_comm, &inter_rank);
MPI_Comm_size(inter_comm, &inter_loc_size);
MPI_Comm_remote_size(inter_comm, &inter_rem_size);
/* Merge the new intercomm into one single univeser: */
MPI_Intercomm_merge(inter_comm, 0, &univ_comm);
MPI_Comm_rank(univ_comm, &univ_rank);
MPI_Comm_size(univ_comm, &univ_size);
/* The following disconnects() will only decrement the VCR reference counters: */
/* (and could thus also be replaced by MPI_Comm_free()...) */
MPI_Comm_disconnect(&inter_comm);
MPI_Comm_disconnect(&merge_comm);
MPI_Comm_disconnect(&spawn_comm);
/* Now, the MPI universe is almost flat: just three worlds forming one universe! */
/* Loop over all ranks for acting as root: */
for(j=0; j<univ_size; j++) {
/* Test, if simple communication works in this new and flat universe: */
if(univ_rank == j) {
int remote_ranks[univ_size];
MPI_Request send_req;
MPI_Request recv_reqs[univ_size];
MPI_Status status_array[univ_size];
for(i=0; i<univ_size; i++) {
MPI_Irecv(&remote_ranks[i], 1, MPI_INT, i, j, univ_comm, &recv_reqs[i]);
}
MPI_Isend(&univ_rank, 1, MPI_INT, j, j, univ_comm, &send_req);
MPI_Waitall(univ_size, recv_reqs, status_array);
for(i=0; i<univ_size; i++) {
if(remote_ranks[i] != i) {
printf("ERROR: Wrong sender in universe! (got %d /& expected %d)\n", i, remote_ranks[i]);
}
}
MPI_Wait(&send_req, MPI_STATUS_IGNORE);
} else {
MPI_Send(&univ_rank, 1, MPI_INT, j, j, univ_comm);
}
}
/* The following disconnect() might already shutdown certain pscom connections */
/* (depending on the setting of ENABLE_LAZY_DISCONNECT in mpid_vc.c ...*/
MPI_Comm_disconnect(&univ_comm);
if(univ_rank == 0) {
printf(" No errors\n");
}
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
int errs = 0;
int i;
int rank, size;
int *excl;
int ranges[1][3];
int isLeft, rleader;
MPI_Group world_group, high_group, even_group;
MPI_Comm local_comm, inter_comm, test_comm, outcomm;
MPI_Comm idupcomms[NUM_IDUPS];
MPI_Request reqs[NUM_IDUPS];
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_group(MPI_COMM_WORLD, &world_group);
if (size < 2) {
printf("this test requires at least 2 processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
/* Idup MPI_COMM_WORLD multiple times */
for (i = 0; i < NUM_IDUPS; i++) {
MPI_Comm_idup(MPI_COMM_WORLD, &idupcomms[i], &reqs[i]);
}
/* Overlap pending idups with various comm generation functions */
/* Comm_dup */
MPI_Comm_dup(MPI_COMM_WORLD, &outcomm);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_split */
MPI_Comm_split(MPI_COMM_WORLD, rank % 2, size - rank, &outcomm);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create, high half of MPI_COMM_WORLD */
ranges[0][0] = size / 2;
ranges[0][1] = size - 1;
ranges[0][2] = 1;
MPI_Group_range_incl(world_group, 1, ranges, &high_group);
MPI_Comm_create(MPI_COMM_WORLD, high_group, &outcomm);
MPI_Group_free(&high_group);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create_group, even ranks of MPI_COMM_WORLD */
/* exclude the odd ranks */
excl = malloc((size / 2) * sizeof(int));
for (i = 0; i < size / 2; i++)
excl[i] = (2 * i) + 1;
MPI_Group_excl(world_group, size / 2, excl, &even_group);
free(excl);
if (rank % 2 == 0) {
MPI_Comm_create_group(MPI_COMM_WORLD, even_group, 0, &outcomm);
} else {
outcomm = MPI_COMM_NULL;
}
MPI_Group_free(&even_group);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Intercomm_create & Intercomm_merge */
MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &local_comm);
if (rank == 0) {
rleader = size / 2;
} else if (rank == size / 2) {
rleader = 0;
} else {
rleader = -1;
}
isLeft = rank < size / 2;
MPI_Intercomm_create(local_comm, 0, MPI_COMM_WORLD, rleader, 99, &inter_comm);
MPI_Intercomm_merge(inter_comm, isLeft, &outcomm);
MPI_Comm_free(&local_comm);
errs += MTestTestComm(inter_comm);
MTestFreeComm(&inter_comm);
errs += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
MPI_Waitall(NUM_IDUPS, reqs, MPI_STATUSES_IGNORE);
for (i = 0; i < NUM_IDUPS; i++) {
errs += MTestTestComm(idupcomms[i]);
MPI_Comm_free(&idupcomms[i]);
}
MPI_Group_free(&world_group);
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
/*
* Get an intracommunicator with at least min_size members. If "allowSmaller"
* is true, allow the communicator to be smaller than MPI_COMM_WORLD and
* for this routine to return MPI_COMM_NULL for some values. Returns 0 if
* no more communicators are available.
*/
int MTestGetIntracommGeneral(MPI_Comm * comm, int min_size, int allowSmaller)
{
int size, rank, merr;
int done = 0;
int isBasic = 0;
/* The while loop allows us to skip communicators that are too small.
* MPI_COMM_NULL is always considered large enough */
while (!done) {
isBasic = 0;
intraCommName = "";
switch (intraCommIdx) {
case 0:
*comm = MPI_COMM_WORLD;
isBasic = 1;
intraCommName = "MPI_COMM_WORLD";
break;
case 1:
/* dup of world */
merr = MPI_Comm_dup(MPI_COMM_WORLD, comm);
if (merr)
MTestPrintError(merr);
intraCommName = "Dup of MPI_COMM_WORLD";
break;
case 2:
/* reverse ranks */
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_split(MPI_COMM_WORLD, 0, size - rank, comm);
if (merr)
MTestPrintError(merr);
intraCommName = "Rank reverse of MPI_COMM_WORLD";
break;
case 3:
/* subset of world, with reversed ranks */
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_split(MPI_COMM_WORLD, ((rank < size / 2) ? 1 : MPI_UNDEFINED),
size - rank, comm);
if (merr)
MTestPrintError(merr);
intraCommName = "Rank reverse of half of MPI_COMM_WORLD";
break;
case 4:
*comm = MPI_COMM_SELF;
isBasic = 1;
intraCommName = "MPI_COMM_SELF";
break;
case 5:
{
#if MTEST_HAVE_MIN_MPI_VERSION(3,0)
/* Dup of the world using MPI_Intercomm_merge */
int rleader, isLeft;
MPI_Comm local_comm, inter_comm;
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (size > 1) {
merr = MPI_Comm_split(MPI_COMM_WORLD, (rank < size / 2), rank, &local_comm);
if (merr)
MTestPrintError(merr);
if (rank == 0) {
rleader = size / 2;
}
else if (rank == size / 2) {
rleader = 0;
}
else {
rleader = -1;
}
isLeft = rank < size / 2;
merr =
MPI_Intercomm_create(local_comm, 0, MPI_COMM_WORLD, rleader, 99,
&inter_comm);
if (merr)
MTestPrintError(merr);
merr = MPI_Intercomm_merge(inter_comm, isLeft, comm);
if (merr)
MTestPrintError(merr);
MPI_Comm_free(&inter_comm);
MPI_Comm_free(&local_comm);
intraCommName = "Dup of WORLD created by MPI_Intercomm_merge";
}
else {
*comm = MPI_COMM_NULL;
}
}
break;
case 6:
{
/* Even of the world using MPI_Comm_create_group */
int i;
MPI_Group world_group, even_group;
int *excl = NULL;
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (allowSmaller && (size + 1) / 2 >= min_size) {
/* exclude the odd ranks */
excl = malloc((size / 2) * sizeof(int));
for (i = 0; i < size / 2; i++)
excl[i] = (2 * i) + 1;
MPI_Comm_group(MPI_COMM_WORLD, &world_group);
MPI_Group_excl(world_group, size / 2, excl, &even_group);
MPI_Group_free(&world_group);
free(excl);
if (rank % 2 == 0) {
/* Even processes create a comm. for themselves */
MPI_Comm_create_group(MPI_COMM_WORLD, even_group, 0, comm);
intraCommName = "Even of WORLD created by MPI_Comm_create_group";
}
else {
*comm = MPI_COMM_NULL;
}
MPI_Group_free(&even_group);
}
else {
*comm = MPI_COMM_NULL;
}
#else
*comm = MPI_COMM_NULL;
#endif
}
break;
case 7:
{
/* High half of the world using MPI_Comm_create */
int ranges[1][3];
MPI_Group world_group, high_group;
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
ranges[0][0] = size / 2;
ranges[0][1] = size - 1;
ranges[0][2] = 1;
if (allowSmaller && (size + 1) / 2 >= min_size) {
MPI_Comm_group(MPI_COMM_WORLD, &world_group);
merr = MPI_Group_range_incl(world_group, 1, ranges, &high_group);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_create(MPI_COMM_WORLD, high_group, comm);
if (merr)
MTestPrintError(merr);
MPI_Group_free(&world_group);
MPI_Group_free(&high_group);
intraCommName = "High half of WORLD created by MPI_Comm_create";
}
else {
*comm = MPI_COMM_NULL;
}
}
break;
/* These next cases are communicators that include some
* but not all of the processes */
case 8:
case 9:
case 10:
case 11:
{
int newsize;
merr = MPI_Comm_size(MPI_COMM_WORLD, &size);
if (merr)
MTestPrintError(merr);
newsize = size - (intraCommIdx - 7);
if (allowSmaller && newsize >= min_size) {
merr = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (merr)
MTestPrintError(merr);
merr = MPI_Comm_split(MPI_COMM_WORLD, rank < newsize, rank, comm);
if (merr)
MTestPrintError(merr);
if (rank >= newsize) {
merr = MPI_Comm_free(comm);
if (merr)
MTestPrintError(merr);
*comm = MPI_COMM_NULL;
}
else {
intraCommName = "Split of WORLD";
}
}
else {
/* Act like default */
*comm = MPI_COMM_NULL;
intraCommIdx = -1;
}
}
break;
/* Other ideas: dup of self, cart comm, graph comm */
default:
*comm = MPI_COMM_NULL;
intraCommIdx = -1;
break;
}
if (*comm != MPI_COMM_NULL) {
merr = MPI_Comm_size(*comm, &size);
if (merr)
MTestPrintError(merr);
if (size >= min_size)
done = 1;
}
else {
intraCommName = "MPI_COMM_NULL";
isBasic = 1;
done = 1;
}
/* we are only done if all processes are done */
MPI_Allreduce(MPI_IN_PLACE, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD);
/* Advance the comm index whether we are done or not, otherwise we could
* spin forever trying to allocate a too-small communicator over and
* over again. */
intraCommIdx++;
if (!done && !isBasic && *comm != MPI_COMM_NULL) {
/* avoid leaking communicators */
merr = MPI_Comm_free(comm);
if (merr)
MTestPrintError(merr);
}
}
return intraCommIdx;
}
int
main (int argc, char **argv)
{
int nprocs = -1;
int rank = -1;
int comm = MPI_COMM_WORLD;
char processor_name[128];
int namelen = 128;
int i;
int ranks[2], ranges[1][3];
MPI_Group newgroup[GROUP_CONSTRUCTOR_COUNT];
MPI_Group newgroup2[GROUP_CONSTRUCTOR_COUNT];
MPI_Comm temp;
MPI_Comm intercomm = MPI_COMM_NULL;
/* init */
MPI_Init (&argc, &argv);
MPI_Comm_size (comm, &nprocs);
MPI_Comm_rank (comm, &rank);
MPI_Get_processor_name (processor_name, &namelen);
printf ("(%d) is alive on %s\n", rank, processor_name);
fflush (stdout);
ranks[0] = 0;
ranks[1] = 1;
ranges[0][0] = 0;
ranges[0][1] = 2;
ranges[0][2] = 2;
MPI_Barrier (comm);
if (nprocs < 3) {
printf ("requires at least 3 tasks\n");
}
else {
/* create the groups */
if (GROUP_CONSTRUCTOR_COUNT > 0)
MPI_Comm_group (MPI_COMM_WORLD, &newgroup[0]);
if (GROUP_CONSTRUCTOR_COUNT > 1)
MPI_Group_incl (newgroup[0], 2, ranks, &newgroup[1]);
if (GROUP_CONSTRUCTOR_COUNT > 2)
MPI_Group_excl (newgroup[0], 2, ranks, &newgroup[2]);
if (GROUP_CONSTRUCTOR_COUNT > 3)
MPI_Group_range_incl (newgroup[0], 1, ranges, &newgroup[3]);
if (GROUP_CONSTRUCTOR_COUNT > 4)
MPI_Group_range_excl (newgroup[0], 1, ranges, &newgroup[4]);
if (GROUP_CONSTRUCTOR_COUNT > 5)
MPI_Group_union (newgroup[1], newgroup[3], &newgroup[5]);
if (GROUP_CONSTRUCTOR_COUNT > 6)
MPI_Group_intersection (newgroup[5], newgroup[2], &newgroup[6]);
if (GROUP_CONSTRUCTOR_COUNT > 7)
MPI_Group_difference (newgroup[5], newgroup[2], &newgroup[7]);
if (GROUP_CONSTRUCTOR_COUNT > 8) {
/* need lots of stuff for this constructor... */
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &temp);
if (rank % 3) {
MPI_Intercomm_create (temp, 0, MPI_COMM_WORLD,
(((nprocs % 3) == 2) && ((rank % 3) == 2)) ?
nprocs - 1 : nprocs - (rank % 3) - (nprocs % 3),
INTERCOMM_CREATE_TAG, &intercomm);
MPI_Comm_remote_group (intercomm, &newgroup[8]);
MPI_Comm_free (&intercomm);
}
else {
MPI_Comm_group (temp, &newgroup[8]);
}
MPI_Comm_free (&temp);
}
}
MPI_Barrier (comm);
printf ("(%d) Finished normally\n", rank);
MPI_Finalize ();
}
int
main (int argc, char **argv)
{
int nprocs = -1;
int rank = -1;
int i, j;
int *granks;
char processor_name[128];
int namelen = 128;
int buf[buf_size];
MPI_Status status;
MPI_Comm temp;
MPI_Comm intercomm = MPI_COMM_NULL;
MPI_Comm dcomms[DCOMM_CALL_COUNT];
MPI_Group world_group, dgroup;
int intersize, dnprocs[DCOMM_CALL_COUNT], drank[DCOMM_CALL_COUNT];
int dims[TWOD], periods[TWOD], remain_dims[TWOD];
int graph_index[] = { 2, 3, 4, 6 };
int graph_edges[] = { 1, 3, 0, 3, 0, 2 };
/* init */
MPI_Init (&argc, &argv);
MPI_Comm_size (MPI_COMM_WORLD, &nprocs);
MPI_Comm_rank (MPI_COMM_WORLD, &rank);
MPI_Get_processor_name (processor_name, &namelen);
printf ("(%d) is alive on %s\n", rank, processor_name);
fflush (stdout);
MPI_Barrier (MPI_COMM_WORLD);
/* probably want number to be higher... */
if (nprocs < 4) {
printf ("not enough tasks\n");
}
else {
if (DCOMM_CALL_COUNT > 0) {
#ifdef RUN_COMM_DUP
/* create all of the derived communicators... */
/* simplest is created by MPI_Comm_dup... */
MPI_Comm_dup (MPI_COMM_WORLD, &dcomms[0]);
#else
dcomms[0] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 1) {
#ifdef RUN_COMM_CREATE
/* use subset of MPI_COMM_WORLD group for MPI_Comm_create... */
MPI_Comm_group (MPI_COMM_WORLD, &world_group);
granks = (int *) malloc (sizeof(int) * (nprocs/2));
for (i = 0; i < nprocs/2; i++)
granks [i] = 2 * i;
MPI_Group_incl (world_group, nprocs/2, granks, &dgroup);
MPI_Comm_create (MPI_COMM_WORLD, dgroup, &dcomms[1]);
MPI_Group_free (&world_group);
MPI_Group_free (&dgroup);
free (granks);
#else
dcomms[1] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 2) {
#ifdef RUN_COMM_SPLIT
/* split into thirds with inverted ranks... */
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &dcomms[2]);
#else
dcomms[2] = MPI_COMM_NULL;
#endif
}
#ifdef RUN_INTERCOMM_CREATE
if ((DCOMM_CALL_COUNT < 2) || (dcomms[2] == MPI_COMM_NULL)) {
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &temp);
}
else {
temp = dcomms[2];
}
if (rank % 3) {
MPI_Intercomm_create (temp, 0, MPI_COMM_WORLD,
(((nprocs % 3) == 2) && ((rank % 3) == 2)) ?
nprocs - 1 : nprocs - (rank % 3) - (nprocs % 3),
INTERCOMM_CREATE_TAG, &intercomm);
}
if ((DCOMM_CALL_COUNT < 2) || (dcomms[2] == MPI_COMM_NULL)) {
MPI_Comm_free (&temp);
}
#endif
if (DCOMM_CALL_COUNT > 3) {
#ifdef RUN_CART_CREATE
/* create a 2 X nprocs/2 torus topology, allow reordering */
dims[0] = 2;
dims[1] = nprocs/2;
periods[0] = periods[1] = 1;
MPI_Cart_create (MPI_COMM_WORLD, TWOD, dims, periods, 1, &dcomms[3]);
#else
dcomms[3] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 4) {
#ifdef RUN_GRAPH_CREATE
/* create the graph on p.268 MPI: The Complete Reference... */
MPI_Graph_create (MPI_COMM_WORLD, GRAPH_SZ,
graph_index, graph_edges, 1, &dcomms[4]);
#else
dcomms[4] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 5) {
#ifdef RUN_CART_SUB
#ifndef RUN_CART_CREATE
/* need to make cartesian communicator temporarily... */
/* create a 2 X nprocs/2 torus topology, allow reordering */
dims[0] = 2;
dims[1] = nprocs/2;
periods[0] = periods[1] = 1;
MPI_Cart_create (MPI_COMM_WORLD, TWOD, dims, periods, 1, &dcomms[3]);
#endif
if (dcomms[3] != MPI_COMM_NULL) {
/* create 2 1 X nprocs/2 topologies... */
remain_dims[0] = 0;
remain_dims[1] = 1;
MPI_Cart_sub (dcomms[3], remain_dims, &dcomms[5]);
#ifndef RUN_CART_CREATE
/* free up temporarily created cartesian communicator... */
MPI_Comm_free (&dcomms[3]);
#endif
}
else {
dcomms[5] = MPI_COMM_NULL;
}
#else
dcomms[5] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 6) {
#ifdef RUN_INTERCOMM_MERGE
#ifndef RUN_INTERCOMM_CREATE
#ifndef RUN_COMM_SPLIT
/* need to make split communicator temporarily... */
/* split into thirds with inverted ranks... */
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &dcomms[2]);
#endif
#endif
/* create an intercommunicator and merge it... */
if (rank % 3) {
#ifndef RUN_INTERCOMM_CREATE
MPI_Intercomm_create (dcomms[2], 0, MPI_COMM_WORLD,
(((nprocs % 3) == 2) && ((rank % 3) == 2)) ?
nprocs - 1 : nprocs - (rank % 3) - (nprocs % 3),
INTERCOMM_CREATE_TAG, &intercomm);
#endif
MPI_Intercomm_merge (intercomm, ((rank % 3) == 1), &dcomms[6]);
#ifndef RUN_INTERCOMM_CREATE
/* we are done with intercomm... */
MPI_Comm_free (&intercomm);
#endif
}
else {
dcomms[6] = MPI_COMM_NULL;
}
#ifndef RUN_INTERCOMM_CREATE
#ifndef RUN_COMM_SPLIT
if (dcomms[2] != MPI_COMM_NULL)
/* free up temporarily created split communicator... */
MPI_Comm_free (&dcomms[2]);
#endif
#endif
#else
dcomms[6] = MPI_COMM_NULL;
#endif
}
/* get all of the sizes and ranks... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
if (dcomms[i] != MPI_COMM_NULL) {
MPI_Comm_size (dcomms[i], &dnprocs[i]);
MPI_Comm_rank (dcomms[i], &drank[i]);
}
else {
dnprocs[i] = 0;
drank[i] = -1;
}
}
#ifdef RUN_INTERCOMM_CREATE
/* get the intercomm remote size... */
if (rank % 3) {
MPI_Comm_remote_size (intercomm, &intersize);
}
#endif
/* do some point to point on all of the dcomms... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
if (dnprocs[i] > 1) {
if (drank[i] == 0) {
for (j = 1; j < dnprocs[i]; j++) {
MPI_Recv (buf, buf_size, MPI_INT, j, 0, dcomms[i], &status);
}
}
else {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, 0, 0, dcomms[i]);
}
}
}
#ifdef RUN_INTERCOMM_CREATE
/* do some point to point on the intercomm... */
if ((rank % 3) == 1) {
for (j = 0; j < intersize; j++) {
MPI_Recv (buf, buf_size, MPI_INT, j, 0, intercomm, &status);
}
}
else if ((rank % 3) == 2) {
for (j = 0; j < intersize; j++) {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, j, 0, intercomm);
}
}
#endif
/* do a bcast on all of the dcomms... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
/* IBM's implementation gets error with comm over MPI_COMM_NULL... */
if (dnprocs[i] > 0)
MPI_Bcast (buf, buf_size, MPI_INT, 0, dcomms[i]);
}
/* use any source receives... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
if (dnprocs[i] > 1) {
if (drank[i] == 0) {
for (j = 1; j < dnprocs[i]; j++) {
MPI_Recv (buf, buf_size, MPI_INT,
MPI_ANY_SOURCE, 0, dcomms[i], &status);
}
}
else {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, 0, 0, dcomms[i]);
}
}
}
#ifdef RUN_INTERCOMM_CREATE
/* do any source receives on the intercomm... */
if ((rank % 3) == 1) {
for (j = 0; j < intersize; j++) {
MPI_Recv (buf, buf_size, MPI_INT,
MPI_ANY_SOURCE, 0, intercomm, &status);
}
}
else if ((rank % 3) == 2) {
for (j = 0; j < intersize; j++) {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, j, 0, intercomm);
}
}
#endif
/* do a barrier on all of the dcomms... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
/* IBM's implementation gets with communication over MPI_COMM_NULL... */
if (dnprocs[i] > 0)
MPI_Barrier (dcomms[i]);
}
/* free all of the derived communicators... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
/* freeing MPI_COMM_NULL is explicitly defined as erroneous... */
if (dnprocs[i] > 0)
MPI_Comm_free (&dcomms[i]);
}
#ifdef RUN_INTERCOMM_CREATE
if (rank % 3)
/* we are done with intercomm... */
MPI_Comm_free (&intercomm);
#endif
}
MPI_Barrier (MPI_COMM_WORLD);
MPI_Finalize ();
printf ("(%d) Finished normally\n", rank);
}
