void ompi_comm_create_f(MPI_Fint *comm, MPI_Fint *group, MPI_Fint *newcomm, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_newcomm;
MPI_Comm c_comm = PMPI_Comm_f2c (*comm);
MPI_Group c_group = PMPI_Group_f2c(*group);
c_ierr = PMPI_Comm_create(c_comm, c_group, &c_newcomm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newcomm = PMPI_Comm_c2f (c_newcomm);
}
}
int create_2level_comm (MPI_Comm comm, int size, int my_rank)
{
static const char FCNAME[] = "create_2level_comm";
int mpi_errno = MPI_SUCCESS;
MPID_Comm* comm_ptr;
MPID_Comm* comm_world_ptr;
MPI_Group subgroup1, comm_group;
MPID_Group *group_ptr=NULL;
int leader_comm_size, my_local_size, my_local_id, input_flag =0, output_flag=0;
int errflag = FALSE;
int leader_group_size=0;
MPIU_THREADPRIV_DECL;
MPIU_THREADPRIV_GET;
MPID_Comm_get_ptr( comm, comm_ptr );
MPID_Comm_get_ptr( MPI_COMM_WORLD, comm_world_ptr );
int* shmem_group = MPIU_Malloc(sizeof(int) * size);
if (NULL == shmem_group){
printf("Couldn't malloc shmem_group\n");
ibv_error_abort (GEN_EXIT_ERR, "create_2level_com");
}
/* Creating local shmem group */
int i = 0;
int local_rank = 0;
int grp_index = 0;
comm_ptr->ch.leader_comm=MPI_COMM_NULL;
comm_ptr->ch.shmem_comm=MPI_COMM_NULL;
MPIDI_VC_t* vc = NULL;
for (; i < size ; ++i){
MPIDI_Comm_get_vc(comm_ptr, i, &vc);
if (my_rank == i || vc->smp.local_rank >= 0){
shmem_group[grp_index] = i;
if (my_rank == i){
local_rank = grp_index;
}
++grp_index;
}
}
/* Creating leader group */
int leader = 0;
leader = shmem_group[0];
/* Gives the mapping to any process's leader in comm */
comm_ptr->ch.leader_map = MPIU_Malloc(sizeof(int) * size);
if (NULL == comm_ptr->ch.leader_map){
printf("Couldn't malloc group\n");
ibv_error_abort (GEN_EXIT_ERR, "create_2level_com");
}
mpi_errno = MPIR_Allgather_impl (&leader, 1, MPI_INT , comm_ptr->ch.leader_map, 1, MPI_INT, comm_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
int* leader_group = MPIU_Malloc(sizeof(int) * size);
if (NULL == leader_group){
printf("Couldn't malloc leader_group\n");
ibv_error_abort (GEN_EXIT_ERR, "create_2level_com");
}
/* Gives the mapping from leader's rank in comm to
* leader's rank in leader_comm */
comm_ptr->ch.leader_rank = MPIU_Malloc(sizeof(int) * size);
if (NULL == comm_ptr->ch.leader_rank){
printf("Couldn't malloc marker\n");
ibv_error_abort (GEN_EXIT_ERR, "create_2level_com");
}
for (i=0; i < size ; ++i){
comm_ptr->ch.leader_rank[i] = -1;
}
int* group = comm_ptr->ch.leader_map;
grp_index = 0;
for (i=0; i < size ; ++i){
if (comm_ptr->ch.leader_rank[(group[i])] == -1){
comm_ptr->ch.leader_rank[(group[i])] = grp_index;
leader_group[grp_index++] = group[i];
}
}
leader_group_size = grp_index;
comm_ptr->ch.leader_group_size = leader_group_size;
mpi_errno = PMPI_Comm_group(comm, &comm_group);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
mpi_errno = PMPI_Group_incl(comm_group, leader_group_size, leader_group, &subgroup1);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
mpi_errno = PMPI_Comm_create(comm, subgroup1, &(comm_ptr->ch.leader_comm));
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
MPID_Comm *leader_ptr;
MPID_Comm_get_ptr( comm_ptr->ch.leader_comm, leader_ptr );
MPIU_Free(leader_group);
MPID_Group_get_ptr( subgroup1, group_ptr );
if(group_ptr != NULL) {
mpi_errno = PMPI_Group_free(&subgroup1);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
}
mpi_errno = PMPI_Comm_split(comm, leader, local_rank, &(comm_ptr->ch.shmem_comm));
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
MPID_Comm *shmem_ptr;
MPID_Comm_get_ptr(comm_ptr->ch.shmem_comm, shmem_ptr);
mpi_errno = PMPI_Comm_rank(comm_ptr->ch.shmem_comm, &my_local_id);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
mpi_errno = PMPI_Comm_size(comm_ptr->ch.shmem_comm, &my_local_size);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
if(my_local_id == 0) {
int array_index=0;
mpi_errno = PMPI_Comm_size(comm_ptr->ch.leader_comm, &leader_comm_size);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
comm_ptr->ch.node_sizes = MPIU_Malloc(sizeof(int)*leader_comm_size);
mpi_errno = PMPI_Allgather(&my_local_size, 1, MPI_INT,
comm_ptr->ch.node_sizes, 1, MPI_INT, comm_ptr->ch.leader_comm);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
comm_ptr->ch.is_uniform = 1;
for(array_index=0; array_index < leader_comm_size; array_index++) {
if(comm_ptr->ch.node_sizes[0] != comm_ptr->ch.node_sizes[array_index]) {
comm_ptr->ch.is_uniform = 0;
break;
}
}
}
comm_ptr->ch.is_global_block = 0;
/* We need to check to see if the ranks are block or not. Each node leader
* gets the global ranks of all of its children processes. It scans through
* this array to see if the ranks are in block order. The node-leaders then
* do an allreduce to see if all the other nodes are also in block order.
* This is followed by an intra-node bcast to let the children processes
* know of the result of this step */
if(my_local_id == 0) {
int is_local_block = 1;
int index = 1;
while( index < my_local_size) {
if( (shmem_group[index] - 1) !=
shmem_group[index - 1]) {
is_local_block = 0;
break;
}
index++;
}
comm_ptr->ch.shmem_coll_ok = 0;/* To prevent Allreduce taking shmem route*/
mpi_errno = MPIR_Allreduce_impl(&(is_local_block),
&(comm_ptr->ch.is_global_block), 1,
MPI_INT, MPI_LAND, leader_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
mpi_errno = MPIR_Bcast_impl(&(comm_ptr->ch.is_global_block),1, MPI_INT, 0,
shmem_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
} else {
mpi_errno = MPIR_Bcast_impl(&(comm_ptr->ch.is_global_block),1, MPI_INT, 0,
shmem_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
}
if (my_local_id == 0){
lock_shmem_region();
increment_shmem_comm_count();
shmem_comm_count = get_shmem_comm_count();
unlock_shmem_region();
}
shmem_ptr->ch.shmem_coll_ok = 0;
/* To prevent Bcast taking the knomial_2level_bcast route */
mpi_errno = MPIR_Bcast_impl (&shmem_comm_count, 1, MPI_INT, 0, shmem_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
if (shmem_comm_count <= g_shmem_coll_blocks){
shmem_ptr->ch.shmem_comm_rank = shmem_comm_count-1;
input_flag = 1;
} else{
input_flag = 0;
}
comm_ptr->ch.shmem_coll_ok = 0;/* To prevent Allreduce taking shmem route*/
mpi_errno = MPIR_Allreduce_impl(&input_flag, &output_flag, 1, MPI_INT, MPI_LAND, comm_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
comm_ptr->ch.allgather_comm_ok = 0;
if (allgather_ranking){
int is_contig =1, check_leader =1, check_size=1, is_local_ok=0,is_block=0;
int PPN;
int shmem_grp_size = my_local_size;
int leader_rank;
MPI_Group allgather_group;
comm_ptr->ch.allgather_comm=MPI_COMM_NULL;
comm_ptr->ch.allgather_new_ranks=NULL;
if(comm_ptr->ch.leader_comm != MPI_COMM_NULL) {
PMPI_Comm_rank(comm_ptr->ch.leader_comm, &leader_rank);
}
mpi_errno=MPIR_Bcast_impl(&leader_rank, 1, MPI_INT, 0, shmem_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
for (i=1; i < shmem_grp_size; i++ ){
if (shmem_group[i] != shmem_group[i-1]+1){
is_contig =0;
break;
}
}
if (leader != (shmem_grp_size*leader_rank)){
check_leader=0;
}
if (shmem_grp_size != (size/leader_group_size)){
check_size=0;
}
is_local_ok = is_contig && check_leader && check_size;
mpi_errno = MPIR_Allreduce_impl(&is_local_ok, &is_block, 1, MPI_INT, MPI_LAND, comm_ptr, &errflag);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
if (is_block){
int counter=0,j;
comm_ptr->ch.allgather_new_ranks = MPIU_Malloc(sizeof(int)*size);
if (NULL == comm_ptr->ch.allgather_new_ranks){
mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE,
FCNAME, __LINE__, MPI_ERR_OTHER,
"**nomem", 0 );
return mpi_errno;
}
PPN = shmem_grp_size;
for (j=0; j < PPN; j++){
for (i=0; i < leader_group_size; i++){
comm_ptr->ch.allgather_new_ranks[counter] = j + i*PPN;
counter++;
}
}
mpi_errno = PMPI_Group_incl(comm_group, size, comm_ptr->ch.allgather_new_ranks, &allgather_group);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
mpi_errno = PMPI_Comm_create(comm_ptr->handle, allgather_group, &(comm_ptr->ch.allgather_comm));
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
comm_ptr->ch.allgather_comm_ok = 1;
mpi_errno=PMPI_Group_free(&allgather_group);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
}
}
mpi_errno=PMPI_Group_free(&comm_group);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
if (output_flag == 1){
comm_ptr->ch.shmem_coll_ok = 1;
comm_registry[comm_registered++] = comm_ptr->context_id;
} else{
comm_ptr->ch.shmem_coll_ok = 0;
MPID_Group_get_ptr( subgroup1, group_ptr );
if(group_ptr != NULL) {
mpi_errno = PMPI_Group_free(&subgroup1);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
}
MPID_Group_get_ptr( comm_group, group_ptr );
if(group_ptr != NULL) {
mpi_errno = PMPI_Group_free(&comm_group);
if(mpi_errno) {
MPIU_ERR_POP(mpi_errno);
}
}
free_2level_comm(comm_ptr);
comm_ptr->ch.shmem_comm = MPI_COMM_NULL;
comm_ptr->ch.leader_comm = MPI_COMM_NULL;
}
++comm_count;
MPIU_Free(shmem_group);
fn_fail:
MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
return (mpi_errno);
}
int MPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm * newcomm)
{
return PMPI_Comm_create(comm, group, newcomm);
}
