same_dtype.c

mpi并行计算的c++代码 可用vc或gcc编译通过 可以用来搭建并行计算试验环境

    err_rank_size = 0;
    for ( idx = 0; idx < size; idx++ ) {
        if ( isOK2chks[idx] ) {
            if ( ! CollChk_hash_equal( &recv_hash, &(hashes[idx]) ) )
                err_ranks[ err_rank_size++ ] = idx;
        }
    }

    if ( err_rank_size > 0 ) {
        str_sz = sprintf(err_str, "Inconsistent datatype signatures detected "
                                  "between local rank %d and remote ranks,",
                                  rank);
        /* all string size variables, *_sz, does not include NULL character */
        err_str_sz = str_sz;
        for ( idx = 0; idx < err_rank_size; idx++ ) {
            str_sz = sprintf(rank_str, " %d", err_ranks[idx] );
            /* -3 is reserved for "..." */
            if ( str_sz + err_str_sz < COLLCHK_STD_STRLEN-3 ) {
                strcat(err_str, rank_str);
                err_str_sz = strlen( err_str );
            }
            else {
                strcat(err_str, "..." );
                break;
            }
        }
    }
    else
        sprintf(err_str, COLLCHK_NO_ERROR_STR);

    /* Find out the total number of unequal hashes in the communicator */
    err_rank_size = CollChk_Allreduce_int(err_rank_size, MPI_SUM, comm);

#if ! defined( HAVE_ALLOCA )
    if ( hashes != NULL )
        free( hashes );
    if ( err_ranks != NULL )
        free( err_ranks );
    if ( isOK2chks != NULL )
        free( isOK2chks );
#endif

    if ( err_rank_size > 0 )
        return CollChk_err_han(err_str, COLLCHK_ERR_DTYPE, call, comm);

    return MPI_SUCCESS;
}


/*
  The vector of (recvtype,recvcnts[]) is assumed to be known locally.
  The routine checks if (recvtype,recvcnts[]) on local process is the same as
  (sendtype,sendcnts[]) collected from all the other processes.
*/
int CollChk_dtype_allgatherv(MPI_Comm comm,
                             MPI_Datatype sendtype, int sendcnt,
                             MPI_Datatype recvtype, int *recvcnts,
                             int are2buffs, char *call)
{
    CollChk_hash_t  *hashes;      /* hash array for (sendtype,sendcnt) */
    CollChk_hash_t  send_hash;    /* local sender's hash value */
    CollChk_hash_t  recv_hash;    /* local receiver's hash value */
    char            err_str[COLLCHK_STD_STRLEN];
    char            rank_str[COLLCHK_SM_STRLEN];
    int             *isOK2chks;   /* boolean array, true:sendbuff=\=recvbuff */
    int             *err_ranks;   /* array of ranks that have mismatch hashes */
    int             err_rank_size;
    int             err_str_sz, str_sz;
    int             rank, size, idx;

#if defined( DEBUG )
    fprintf( stdout, "CollChk_dtype_allgatherv()\n" );
#endif

    /* get the rank and size */
    MPI_Comm_rank(comm, &rank);
    MPI_Comm_size(comm, &size);

    /* Allocate hash buffer memory */
#if ! defined( HAVE_ALLOCA )
    hashes    = (CollChk_hash_t *) malloc( size * sizeof(CollChk_hash_t) );
    err_ranks = (int *) malloc( size * sizeof(int) );
    isOK2chks = (int *) malloc( size * sizeof(int) );
#else
    hashes    = (CollChk_hash_t *) alloca( size * sizeof(CollChk_hash_t) );
    err_ranks = (int *) alloca( size * sizeof(int) );
    isOK2chks = (int *) alloca( size * sizeof(int) );
#endif

    CollChk_dtype_hash( sendtype, sendcnt, &send_hash );

    /* Gather other senders' datatype hashes as local hash array */
    PMPI_Allgather(&send_hash, 2, MPI_UNSIGNED, hashes, 2, MPI_UNSIGNED, comm);
    PMPI_Allgather(&are2buffs, 1, MPI_INT, isOK2chks, 1, MPI_INT, comm);

    /* Compare the local datatype hash with other senders' datatype hashes */
    /*
       The checks are more exhaustive and redundant tests on all processes,
       but matches what user expects
    */
    err_rank_size = 0;
    for ( idx = 0; idx < size; idx++ ) {
        if ( isOK2chks[idx] ) {
            CollChk_dtype_hash( recvtype, recvcnts[idx], &recv_hash );
            if ( ! CollChk_hash_equal( &recv_hash, &(hashes[idx]) ) )
                err_ranks[ err_rank_size++ ] = idx;
        }
    }

    if ( err_rank_size > 0 ) {
        str_sz = sprintf(err_str, "Inconsistent datatype signatures detected "
                                  "between local rank %d and remote ranks,",
                                  rank);
        /* all string size variables, *_sz, does not include NULL character */
        err_str_sz = str_sz;
        for ( idx = 0; idx < err_rank_size; idx++ ) {
            str_sz = sprintf(rank_str, " %d", err_ranks[idx] );
            /* -3 is reserved for "..." */
            if ( str_sz + err_str_sz < COLLCHK_STD_STRLEN-3 ) {
                strcat(err_str, rank_str);
                err_str_sz = strlen( err_str );
            }
            else {
                strcat(err_str, "..." );
                break;
            }
        }
    }
    else
        sprintf(err_str, COLLCHK_NO_ERROR_STR);

    /* Find out the total number of unequal hashes in the communicator */
    err_rank_size = CollChk_Allreduce_int(err_rank_size, MPI_SUM, comm);

#if ! defined( HAVE_ALLOCA )
    if ( hashes != NULL )
        free( hashes );
    if ( err_ranks != NULL )
        free( err_ranks );
    if ( isOK2chks != NULL )
        free( isOK2chks );
#endif

    if ( err_rank_size > 0 )
        return CollChk_err_han(err_str, COLLCHK_ERR_DTYPE, call, comm);

    return MPI_SUCCESS;
}


/*
  The vector of (recvtype,recvcnts[]) is assumed to be known locally.
  The routine checks if (recvtype,recvcnts[]) on local process is the same as
  (sendtype,sendcnts[]) collected from all the other processes.
*/
int CollChk_dtype_alltoallv(MPI_Comm comm,
                            MPI_Datatype sendtype, int *sendcnts,
                            MPI_Datatype recvtype, int *recvcnts,
                            char *call)
{
    CollChk_hash_t  *send_hashes;    /* hash array for (sendtype,sendcnt[]) */
    CollChk_hash_t  *hashes;         /* hash array for (sendtype,sendcnt[]) */
    CollChk_hash_t  recv_hash;       /* local receiver's hash value */
    char            err_str[COLLCHK_STD_STRLEN];
    char            rank_str[COLLCHK_SM_STRLEN];
    int             *err_ranks;
    int             err_rank_size;
    int             err_str_sz, str_sz;
    int             rank, size, idx;

#if defined( DEBUG )
    fprintf( stdout, "CollChk_dtype_alltoallv()\n" );
#endif

    /* get the rank and size */
    MPI_Comm_rank(comm, &rank);
    MPI_Comm_size(comm, &size);

    /* Allocate hash buffer memory */
#if ! defined( HAVE_ALLOCA )
    send_hashes = (CollChk_hash_t *) malloc( size * sizeof(CollChk_hash_t) );
    hashes      = (CollChk_hash_t *) malloc( size * sizeof(CollChk_hash_t) );
    err_ranks   = (int *) malloc( size * sizeof(int) );
#else
    send_hashes = (CollChk_hash_t *) alloca( size * sizeof(CollChk_hash_t) );
    hashes      = (CollChk_hash_t *) alloca( size * sizeof(CollChk_hash_t) );
    err_ranks   = (int *) alloca( size * sizeof(int) );
#endif

    for ( idx = 0; idx < size; idx++ )
        CollChk_dtype_hash( sendtype, sendcnts[idx], &send_hashes[idx] );

    /* Gather other senders' datatype hashes as local hash array */
    PMPI_Alltoall(send_hashes, 2, MPI_UNSIGNED, hashes, 2, MPI_UNSIGNED, comm);

    /* Compare the local datatype hash with other senders' datatype hashes */
    /*
       The checks are more exhaustive and redundant tests on all processes,
       but matches what user expects
    */
    err_rank_size = 0;
    for ( idx = 0; idx < size; idx++ ) {
        CollChk_dtype_hash( recvtype, recvcnts[idx], &recv_hash );
        if ( ! CollChk_hash_equal( &recv_hash, &(hashes[idx]) ) )
            err_ranks[ err_rank_size++ ] = idx;
    }

    if ( err_rank_size > 0 ) {
        str_sz = sprintf(err_str, "Inconsistent datatype signatures detected "
                                  "between local rank %d and remote ranks,",
                                  rank);
        /* all string size variables, *_sz, does not include NULL character */
        err_str_sz = str_sz;
        for ( idx = 0; idx < err_rank_size; idx++ ) {
            str_sz = sprintf(rank_str, " %d", err_ranks[idx] );
            /* -3 is reserved for "..." */
            if ( str_sz + err_str_sz < COLLCHK_STD_STRLEN-3 ) {
                strcat(err_str, rank_str);
                err_str_sz = strlen( err_str );
            }
            else {
                strcat(err_str, "..." );
                break;
            }
        }
    }
    else
        sprintf(err_str, COLLCHK_NO_ERROR_STR);

    /* Find out the total number of unequal hashes in the communicator */
    err_rank_size = CollChk_Allreduce_int(err_rank_size, MPI_SUM, comm);

#if ! defined( HAVE_ALLOCA )
    if ( send_hashes != NULL )
        free( send_hashes );
    if ( hashes != NULL )
        free( hashes );
    if ( err_ranks != NULL )
        free( err_ranks );
#endif

    if ( err_rank_size > 0 )
        return CollChk_err_han(err_str, COLLCHK_ERR_DTYPE, call, comm);

    return MPI_SUCCESS;
}


/*
  The vector of (recvtypes[],recvcnts[]) is assumed to be known locally.
  The routine checks if (recvtypes[],recvcnts[]) on local process is the same as
  (sendtype[],sendcnts[]) collected from all the other processes.
*/
int CollChk_dtype_alltoallw(MPI_Comm comm,
                            MPI_Datatype *sendtypes, int *sendcnts,
                            MPI_Datatype *recvtypes, int *recvcnts,
                            char *call)
{
    CollChk_hash_t  *send_hashes;  /* hash array for (sendtypes[],sendcnt[]) */
    CollChk_hash_t  *hashes;       /* hash array for (sendtypes[],sendcnt[]) */
    CollChk_hash_t  recv_hash;     /* local receiver's hash value */
    char            err_str[COLLCHK_STD_STRLEN];
    char            rank_str[COLLCHK_SM_STRLEN];
    int             *err_ranks;
    int             err_rank_size;
    int             err_str_sz, str_sz;
    int             rank, size, idx;

    /* get the rank and size */
    MPI_Comm_rank(comm, &rank);
    MPI_Comm_size(comm, &size);

    /* Allocate hash buffer memory */
#if ! defined( HAVE_ALLOCA )
    send_hashes = (CollChk_hash_t *) malloc( size * sizeof(CollChk_hash_t) );
    hashes      = (CollChk_hash_t *) malloc( size * sizeof(CollChk_hash_t) );
    err_ranks   = (int *) malloc( size * sizeof(int) );
#else
    send_hashes = (CollChk_hash_t *) alloca( size * sizeof(CollChk_hash_t) );
    hashes      = (CollChk_hash_t *) alloca( size * sizeof(CollChk_hash_t) );
    err_ranks   = (int *) alloca( size * sizeof(int) );
#endif

    for ( idx = 0; idx < size; idx++ )
        CollChk_dtype_hash( sendtypes[idx], sendcnts[idx], &send_hashes[idx] );

    /* Gather other senders' datatype hashes as local hash array */
    PMPI_Alltoall(send_hashes, 2, MPI_UNSIGNED, hashes, 2, MPI_UNSIGNED, comm);

    /* Compare the local datatype hashes with other senders' datatype hashes */
    /*
       The checks are more exhaustive and redundant tests on all processes,
       but matches what user expects
    */
    err_rank_size = 0;
    for ( idx = 0; idx < size; idx++ ) {
        CollChk_dtype_hash( recvtypes[idx], recvcnts[idx], &recv_hash );
        if ( ! CollChk_hash_equal( &recv_hash, &(hashes[idx]) ) )
            err_ranks[ err_rank_size++ ] = idx;
    }

    if ( err_rank_size > 0 ) {
        str_sz = sprintf(err_str, "Inconsistent datatype signatures detected "
                                  "between local rank %d and remote ranks,",
                                  rank);
        /* all string size variables, *_sz, does not include NULL character */
        err_str_sz = str_sz;
        for ( idx = 0; idx < err_rank_size; idx++ ) {
            str_sz = sprintf(rank_str, " %d", err_ranks[idx] );
            /* -3 is reserved for "..." */
            if ( str_sz + err_str_sz < COLLCHK_STD_STRLEN-3 ) {
                strcat(err_str, rank_str);
                err_str_sz = strlen( err_str );
            }
            else {
                strcat(err_str, "..." );
                break;
            }
        }
    }
    else
        sprintf(err_str, COLLCHK_NO_ERROR_STR);

    /* Find out the total number of unequal hashes in the communicator */
    err_rank_size = CollChk_Allreduce_int(err_rank_size, MPI_SUM, comm);

#if ! defined( HAVE_ALLOCA )
    if ( send_hashes != NULL )
        free( send_hashes );
    if ( hashes != NULL )
        free( hashes );
    if ( err_ranks != NULL )
        free( err_ranks );
#endif

    if ( err_rank_size > 0 )
        return CollChk_err_han(err_str, COLLCHK_ERR_DTYPE, call, comm);

    return MPI_SUCCESS;
}