Blame src/mpi/group/group_excl.c

Packit Service c5cf8c
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
Packit Service c5cf8c
/*
Packit Service c5cf8c
 *
Packit Service c5cf8c
 *  (C) 2001 by Argonne National Laboratory.
Packit Service c5cf8c
 *      See COPYRIGHT in top-level directory.
Packit Service c5cf8c
 */
Packit Service c5cf8c
Packit Service c5cf8c
#include "mpiimpl.h"
Packit Service c5cf8c
#include "group.h"
Packit Service c5cf8c
Packit Service c5cf8c
/* -- Begin Profiling Symbol Block for routine MPI_Group_excl */
Packit Service c5cf8c
#if defined(HAVE_PRAGMA_WEAK)
Packit Service c5cf8c
#pragma weak MPI_Group_excl = PMPI_Group_excl
Packit Service c5cf8c
#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
Packit Service c5cf8c
#pragma _HP_SECONDARY_DEF PMPI_Group_excl  MPI_Group_excl
Packit Service c5cf8c
#elif defined(HAVE_PRAGMA_CRI_DUP)
Packit Service c5cf8c
#pragma _CRI duplicate MPI_Group_excl as PMPI_Group_excl
Packit Service c5cf8c
#elif defined(HAVE_WEAK_ATTRIBUTE)
Packit Service c5cf8c
int MPI_Group_excl(MPI_Group group, int n, const int ranks[], MPI_Group * newgroup)
Packit Service c5cf8c
    __attribute__ ((weak, alias("PMPI_Group_excl")));
Packit Service c5cf8c
#endif
Packit Service c5cf8c
/* -- End Profiling Symbol Block */
Packit Service c5cf8c
Packit Service c5cf8c
/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
Packit Service c5cf8c
   the MPI routines */
Packit Service c5cf8c
#ifndef MPICH_MPI_FROM_PMPI
Packit Service c5cf8c
#undef MPI_Group_excl
Packit Service c5cf8c
#define MPI_Group_excl PMPI_Group_excl
Packit Service c5cf8c
Packit Service c5cf8c
#undef FUNCNAME
Packit Service c5cf8c
#define FUNCNAME MPIR_Group_excl_impl
Packit Service c5cf8c
#undef FCNAME
Packit Service c5cf8c
#define FCNAME MPL_QUOTE(FUNCNAME)
Packit Service c5cf8c
int MPIR_Group_excl_impl(MPIR_Group * group_ptr, int n, const int ranks[],
Packit Service c5cf8c
                         MPIR_Group ** new_group_ptr)
Packit Service c5cf8c
{
Packit Service c5cf8c
    int mpi_errno = MPI_SUCCESS;
Packit Service c5cf8c
    int size, i, newi;
Packit Service c5cf8c
    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_GROUP_EXCL_IMPL);
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_GROUP_EXCL_IMPL);
Packit Service c5cf8c
Packit Service c5cf8c
    size = group_ptr->size;
Packit Service c5cf8c
Packit Service c5cf8c
    /* Allocate a new group and lrank_to_lpid array */
Packit Service c5cf8c
    mpi_errno = MPIR_Group_create(size - n, new_group_ptr);
Packit Service c5cf8c
    if (mpi_errno)
Packit Service c5cf8c
        MPIR_ERR_POP(mpi_errno);
Packit Service c5cf8c
Packit Service c5cf8c
    (*new_group_ptr)->rank = MPI_UNDEFINED;
Packit Service c5cf8c
    /* Use flag fields to mark the members to *exclude* . */
Packit Service c5cf8c
Packit Service c5cf8c
    for (i = 0; i < size; i++) {
Packit Service c5cf8c
        group_ptr->lrank_to_lpid[i].flag = 0;
Packit Service c5cf8c
    }
Packit Service c5cf8c
    for (i = 0; i < n; i++) {
Packit Service c5cf8c
        group_ptr->lrank_to_lpid[ranks[i]].flag = 1;
Packit Service c5cf8c
    }
Packit Service c5cf8c
Packit Service c5cf8c
    newi = 0;
Packit Service c5cf8c
    for (i = 0; i < size; i++) {
Packit Service c5cf8c
        if (group_ptr->lrank_to_lpid[i].flag == 0) {
Packit Service c5cf8c
            (*new_group_ptr)->lrank_to_lpid[newi].lpid = group_ptr->lrank_to_lpid[i].lpid;
Packit Service c5cf8c
            if (group_ptr->rank == i)
Packit Service c5cf8c
                (*new_group_ptr)->rank = newi;
Packit Service c5cf8c
            newi++;
Packit Service c5cf8c
        }
Packit Service c5cf8c
    }
Packit Service c5cf8c
Packit Service c5cf8c
    (*new_group_ptr)->size = size - n;
Packit Service c5cf8c
    (*new_group_ptr)->idx_of_first_lpid = -1;
Packit Service c5cf8c
    /* TODO calculate is_local_dense_monotonic */
Packit Service c5cf8c
Packit Service c5cf8c
  fn_exit:
Packit Service c5cf8c
    MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_GROUP_EXCL_IMPL);
Packit Service c5cf8c
    return mpi_errno;
Packit Service c5cf8c
  fn_fail:
Packit Service c5cf8c
    goto fn_exit;
Packit Service c5cf8c
}
Packit Service c5cf8c
Packit Service c5cf8c
Packit Service c5cf8c
#endif
Packit Service c5cf8c
Packit Service c5cf8c
#undef FUNCNAME
Packit Service c5cf8c
#define FUNCNAME MPI_Group_excl
Packit Service c5cf8c
#undef FCNAME
Packit Service c5cf8c
#define FCNAME MPL_QUOTE(FUNCNAME)
Packit Service c5cf8c
Packit Service c5cf8c
/*@
Packit Service c5cf8c
Packit Service c5cf8c
MPI_Group_excl - Produces a group by reordering an existing group and taking
Packit Service c5cf8c
        only unlisted members
Packit Service c5cf8c
Packit Service c5cf8c
Input Parameters:
Packit Service c5cf8c
+ group - group (handle)
Packit Service c5cf8c
. n - number of elements in array 'ranks' (integer)
Packit Service c5cf8c
- ranks - array of integer ranks in 'group' not to appear in 'newgroup'
Packit Service c5cf8c
Packit Service c5cf8c
Output Parameters:
Packit Service c5cf8c
. newgroup - new group derived from above, preserving the order defined by
Packit Service c5cf8c
 'group' (handle)
Packit Service c5cf8c
Packit Service c5cf8c
Note:
Packit Service c5cf8c
The MPI standard requires that each of the ranks to excluded must be
Packit Service c5cf8c
a valid rank in the group and all elements must be distinct or the
Packit Service c5cf8c
function is erroneous.
Packit Service c5cf8c
Packit Service c5cf8c
.N ThreadSafe
Packit Service c5cf8c
Packit Service c5cf8c
.N Fortran
Packit Service c5cf8c
Packit Service c5cf8c
.N Errors
Packit Service c5cf8c
.N MPI_SUCCESS
Packit Service c5cf8c
.N MPI_ERR_GROUP
Packit Service c5cf8c
.N MPI_ERR_EXHAUSTED
Packit Service c5cf8c
.N MPI_ERR_ARG
Packit Service c5cf8c
.N MPI_ERR_RANK
Packit Service c5cf8c
Packit Service c5cf8c
.seealso: MPI_Group_free
Packit Service c5cf8c
@*/
Packit Service c5cf8c
int MPI_Group_excl(MPI_Group group, int n, const int ranks[], MPI_Group * newgroup)
Packit Service c5cf8c
{
Packit Service c5cf8c
    int mpi_errno = MPI_SUCCESS;
Packit Service c5cf8c
    MPIR_Group *group_ptr = NULL, *new_group_ptr;
Packit Service c5cf8c
    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_GROUP_EXCL);
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_ERRTEST_INITIALIZED_ORDIE();
Packit Service c5cf8c
Packit Service c5cf8c
    MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
Packit Service c5cf8c
    MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_GROUP_EXCL);
Packit Service c5cf8c
    /* Validate parameters, especially handles needing to be converted */
Packit Service c5cf8c
#ifdef HAVE_ERROR_CHECKING
Packit Service c5cf8c
    {
Packit Service c5cf8c
        MPID_BEGIN_ERROR_CHECKS;
Packit Service c5cf8c
        {
Packit Service c5cf8c
            MPIR_ERRTEST_GROUP(group, mpi_errno);
Packit Service c5cf8c
            MPIR_ERRTEST_ARGNEG(n, "n", mpi_errno);
Packit Service c5cf8c
        }
Packit Service c5cf8c
        MPID_END_ERROR_CHECKS;
Packit Service c5cf8c
    }
Packit Service c5cf8c
#endif
Packit Service c5cf8c
Packit Service c5cf8c
    /* Convert MPI object handles to object pointers */
Packit Service c5cf8c
    MPIR_Group_get_ptr(group, group_ptr);
Packit Service c5cf8c
Packit Service c5cf8c
#ifdef HAVE_ERROR_CHECKING
Packit Service c5cf8c
    {
Packit Service c5cf8c
        MPID_BEGIN_ERROR_CHECKS;
Packit Service c5cf8c
        {
Packit Service c5cf8c
            /* Validate group_ptr */
Packit Service c5cf8c
            MPIR_Group_valid_ptr(group_ptr, mpi_errno);
Packit Service c5cf8c
            /* If group_ptr is not valid, it will be reset to null */
Packit Service c5cf8c
            if (group_ptr) {
Packit Service c5cf8c
                mpi_errno = MPIR_Group_check_valid_ranks(group_ptr, ranks, n);
Packit Service c5cf8c
            }
Packit Service c5cf8c
            if (mpi_errno)
Packit Service c5cf8c
                goto fn_fail;
Packit Service c5cf8c
        }
Packit Service c5cf8c
        MPID_END_ERROR_CHECKS;
Packit Service c5cf8c
    }
Packit Service c5cf8c
#endif /* HAVE_ERROR_CHECKING */
Packit Service c5cf8c
Packit Service c5cf8c
    /* ... body of routine ...  */
Packit Service c5cf8c
Packit Service c5cf8c
    if (group_ptr->size == n) {
Packit Service c5cf8c
        *newgroup = MPI_GROUP_EMPTY;
Packit Service c5cf8c
        goto fn_exit;
Packit Service c5cf8c
    }
Packit Service c5cf8c
    mpi_errno = MPIR_Group_excl_impl(group_ptr, n, ranks, &new_group_ptr);
Packit Service c5cf8c
    if (mpi_errno)
Packit Service c5cf8c
        goto fn_fail;
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_OBJ_PUBLISH_HANDLE(*newgroup, new_group_ptr->handle);
Packit Service c5cf8c
Packit Service c5cf8c
    /* ... end of body of routine ... */
Packit Service c5cf8c
Packit Service c5cf8c
  fn_exit:
Packit Service c5cf8c
    MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_GROUP_EXCL);
Packit Service c5cf8c
    MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
Packit Service c5cf8c
    return mpi_errno;
Packit Service c5cf8c
Packit Service c5cf8c
  fn_fail:
Packit Service c5cf8c
    /* --BEGIN ERROR HANDLING-- */
Packit Service c5cf8c
#ifdef HAVE_ERROR_CHECKING
Packit Service c5cf8c
    {
Packit Service c5cf8c
        mpi_errno =
Packit Service c5cf8c
            MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
Packit Service c5cf8c
                                 "**mpi_group_excl", "**mpi_group_excl %G %d %p %p", group, n,
Packit Service c5cf8c
                                 ranks, newgroup);
Packit Service c5cf8c
    }
Packit Service c5cf8c
#endif
Packit Service c5cf8c
    mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
Packit Service c5cf8c
    goto fn_exit;
Packit Service c5cf8c
    /* --END ERROR HANDLING-- */
Packit Service c5cf8c
}