/**
* Destroys the given comex igroup.
*/
void comex_igroup_finalize(comex_igroup_t *igroup)
{
int status;
win_link_t *curr_win;
win_link_t *next_win;
assert(igroup);
if (igroup->group != MPI_GROUP_NULL) {
status = MPI_Group_free(&igroup->group);
if (status != MPI_SUCCESS) {
comex_error("MPI_Group_free: Failed ", status);
}
}
if (igroup->comm != MPI_COMM_NULL) {
status = MPI_Comm_free(&igroup->comm);
if (status != MPI_SUCCESS) {
comex_error("MPI_Comm_free: Failed ", status);
}
}
/* Remove all windows associated with this group */
curr_win = igroup->win_list;
while (curr_win != NULL) {
next_win = curr_win->next;
MPI_Win_free(&curr_win->win);
free(curr_win);
curr_win = next_win;
}
}
/**
* Destroys the given comex_igroup_t.
*/
static void comex_igroup_finalize(comex_igroup_t *igroup)
{
int status;
assert(igroup);
status = MPI_Group_free(&igroup->group);
if (status != MPI_SUCCESS) {
comex_error("MPI_Group_free: Failed ", status);
}
if (igroup->comm != MPI_COMM_NULL) {
status = MPI_Comm_free(&igroup->comm);
if (status != MPI_SUCCESS) {
comex_error("MPI_Comm_free: Failed ", status);
}
}
}
/**
* Translates the given rank from the given group into that of the world group.
*/
int comex_group_translate_world(comex_group_t id, int group_rank, int *world_rank)
{
int status;
MPI_Group world_group;
comex_igroup_t *igroup = comex_get_igroup_from_group(id);
status = MPI_Comm_group(l_state.world_comm, &world_group);
if (status != MPI_SUCCESS) {
comex_error("MPI_Comm_group: Failed ", status);
}
status = MPI_Group_translate_ranks(
igroup->group, 1, &group_rank, world_group, world_rank);
if (status != MPI_SUCCESS) {
comex_error("MPI_Group_translate_ranks: Failed ", status);
}
return COMEX_SUCCESS;
}
/**
* Returns the size of a group.
*/
int comex_group_size(comex_group_t id, int *size)
{
int status;
comex_igroup_t *igroup = comex_get_igroup_from_group(id);
status = MPI_Group_size(igroup->group, size);
if (status != MPI_SUCCESS) {
comex_error("MPI_Group_size: Failed ", status);
}
return COMEX_SUCCESS;
}
/**
* Returns the rank of this process within the given group.
*/
int comex_group_rank(comex_group_t id, int *rank)
{
int status;
comex_igroup_t *igroup = comex_get_igroup_from_group(id);
status = MPI_Group_rank(igroup->group, rank);
if (status != MPI_SUCCESS) {
comex_error("MPI_Group_rank: Failed ", status);
}
return COMEX_SUCCESS;
}
void PARMCI_Memget(size_t bytes, armci_meminfo_t *meminfo, int memflg)
{
void *myptr=NULL;
void *armci_ptr=NULL; /* legal ARCMI ptr used in ARMCI data xfer ops*/
size_t size = bytes;
int rank;
comex_group_rank(COMEX_GROUP_WORLD, &rank);
if(size<=0) comex_error("PARMCI_Memget: size must be > 0", (int)size);
if(meminfo==NULL) comex_error("PARMCI_Memget: Invalid arg #2 (NULL ptr)",0);
if(memflg!=0) comex_error("PARMCI_Memget: Invalid memflg", memflg);
armci_ptr = myptr = comex_malloc_local(size);
if(size) if(!myptr) comex_error("PARMCI_Memget failed", (int)size);
/* fill the meminfo structure */
meminfo->armci_addr = armci_ptr;
meminfo->addr = myptr;
meminfo->size = size;
meminfo->cpid = rank;
/* meminfo->attr = NULL; */
}
void* PARMCI_Memat(armci_meminfo_t *meminfo, long offset)
{
void *ptr=NULL;
int rank;
comex_group_rank(COMEX_GROUP_WORLD, &rank);
if(meminfo==NULL) comex_error("PARMCI_Memat: Invalid arg #1 (NULL ptr)",0);
if(meminfo->cpid==rank) { ptr = meminfo->addr; return ptr; }
ptr = meminfo->addr;
return ptr;
}
/**
* Return the comex_igroup_t instance given the comex_group_t.
*
* The group linked list is searched sequentially until the given group
* is found. It is an error if this function is called before
* comex_group_init(). An error occurs if the given group is not found.
*/
comex_igroup_t* comex_get_igroup_from_group(comex_group_t id)
{
comex_igroup_t *current_group_list_item = group_list;
assert(group_list != NULL);
while (current_group_list_item != NULL) {
if (current_group_list_item->id == id) {
return current_group_list_item;
}
current_group_list_item = current_group_list_item->next;
}
comex_error("comex_group_t lookup failed", -1);
return NULL;
}
int comex_group_translate_world(comex_group_t group, int group_rank, int *world_rank)
{
if (COMEX_GROUP_WORLD == group) {
*world_rank = group_rank;
}
else {
comex_igroup_t *igroup = comex_get_igroup_from_group(group);
comex_igroup_t *world_igroup = comex_get_igroup_from_group(COMEX_GROUP_WORLD);
int status = MPI_Group_translate_ranks(
igroup->group, 1, &group_rank, world_igroup->group, world_rank);
if (status != MPI_SUCCESS) {
comex_error("MPI_Group_translate_ranks: Failed ", status);
}
}
return COMEX_SUCCESS;
}
void PARMCI_Memctl(armci_meminfo_t *meminfo)
{
int rank;
comex_group_rank(COMEX_GROUP_WORLD, &rank);
if(meminfo==NULL) comex_error("PARMCI_Memget: Invalid arg #2 (NULL ptr)",0);
/* only the creator can delete the segment */
if(meminfo->cpid == rank)
{
void *ptr = meminfo->addr;
comex_free_local(ptr);
}
meminfo->addr = NULL;
meminfo->armci_addr = NULL;
/* if(meminfo->attr!=NULL) free(meminfo->attr); */
}
void ARMCI_Error(char *msg, int code)
{
comex_error(msg, code);
}
/**
* 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;
}
