Example use of MPI_Type_compact

Nathan E. Doss (doss@ERC.MsState.Edu)
Thu, 27 Jul 1995 19:45:31 -0500 (CDT)

Steve asked that I provide an example of using MPI_TYPE_COMPACT
in a collective operation. I've included a simplified version of
MPI_GATHER that demonstrates a possible use.

For reference, here's the suggested function:

MPI_TYPE_COMPACT ( type, compact_type )
IN type datatype to be compacted
OUT compact_type datatype with identical type signature
as "type", but with possibly smaller real
extent

--
Nathan Doss                  doss@ERC.MsState.Edu




/*
 *  Simple gather function using MPI_Type_compact.
 *  It makes the following simplifications:
 *    a) root is always 0
 *    b) temporary buffer on intermediate nodes
 *       is bigger than it need be
 *    c) leaf nodes unecessarily allocate temporary
 *       buffer & make an extra copy
 */


int MPI_Gather(sbuf, scnt, stype, rbuf, rcnt, rtype, comm)
void         *sbuf;
int           scnt;
MPI_Datatype  stype;
void         *rbuf;
int           rcnt;
MPI_Datatype  rtype;
MPI_Comm      comm;
{
    int        rank, size, source, dest, total_count, root = 0;
    MPI_Aint   extent;
    int        mask = 0x1;
    MPI_Status status;
    
    MPI_Comm_rank ( comm, &rank );
    MPI_Comm_size ( comm, &size );


    /* rbuf,rcnt,rtype only valid on root */
    if (rank != root) {
        MPI_Type_compact ( stype, &rtype );
        MPI_Type_extent ( rtype, &extent );
        rbuf = (void *) malloc ( extent );
        rcnt = scnt;
    }
    comm = /* collective communiator */;


    /* Copy send buffer to recvbuf */
    MPI_Sendrecv(sbuf,scnt,stype,rank,GATHER_TAG,
                 rbuf,rcnt,rtype,rank,GATHER_TAG,comm,&status);


    /* Do the gather using a spanning tree */
    total_count = rcnt;
    while (mask < size) {


        /* Receiver */
        if ((mask & rank) == 0) {
            source = (rank | mask);
            if (source < size) {
                mpi_errno = MPI_Recv (rbuf + (offset * source),
                                      size*rcnt,  /* a "large" number */
                                      rtype,
                                      source,
                                      GATHER_TAG, comm, &status);
                MPI_Get_count( &status, rtype, &len );
                total_count += len;
            }
        }
        /* Sender */
        else {
            dest = (rank & (~ mask));
            MPI_Send( rbuf + (offset * rank),
                      total_count, rtype,
                      dest,
                      GATHER_TAG,
                      comm );
            break;
        }
        mask <<= 1;
    }


    /* Clean up */
    if (rank != root) {
        free (rbuf);
        MPI_Type_free ( &rtype );
    }


    return (MPI_SUCCESS);
}