Michael J. Quinn, 《Parallel Programming in C with MPI and OpenMP》程序代码

本文中是Michael J. Quinn在书《Parallel Programming in C with MPI and OpenMP》（中文《MPI与OpenMP并行程序设计：C语言版》，陈文光、武永卫等译）中所使用的MyMPI.h和MyMPI.c文件. 有小部分细节上的调整，并经过测试可用.

MyMPI.h

/* MyMPI.h * * Header file for a library of matrix/vector * input/output/redistribution functions. * * Programed by Michael J. Quinn * Last modification: 4 September 2002 * "Parallel Programming in C with MPI and OpenMP" * Typed and modified by xiu_dim, 17 Nov. 2015 *//******************** MACROS *********************/#define DATA_MSG        0#define PROMPT_MSG      1#define RESPONSE_MSG    2#define OPEN_FILE_ERROR -1#define MALLOC_ERROR    -2#define TYPE_ERROR      -3#define PTR_SIZE        (sizeof(void *))#define MIN(a,b)        ((a)<(b)?(a):(b))#define CEILING(i,j)    (((i)+(j)-1)/(j))#define BLOCK_LOW(id,p,n)   ((id)*(n)/(p))#define BLOCK_HIGH(id,p,n)  (BLOCK_LOW((id)+1,p,n)-1)#define BLOCK_SIZE(id,p,n)  \            (BLOCK_HIGH(id,p,n)-BLOCK_LOW(id,p,n)+1)#define BLOCK_OWNER(j,p,n)  (((p)*((j)+1)-1)/(n))/************ MISCELLANEOUS FUNCTIONS ************/int get_size(MPI_Datatype);void* my_malloc(int, int);void terminate(int, char*);/********** DATA DISTRIBUTION FUNCTIONS **********/void create_mixed_xfer_arrays(int, int, int,         int**, int**);void create_uniform_xfer_arrays(int, int, int,         int**, int**);void replicate_block_vector(void*, int, void*,         MPI_Datatype, MPI_Comm);/**************** INPUT FUNCTIONS ****************/void read_row_striped_matrix(char*, void***, void**,         MPI_Datatype, int*, int*, MPI_Comm);void read_col_striped_matrix(char*, void***, void**,         MPI_Datatype, int*, int*, MPI_Comm);void read_checkerboard_matrix(char*, void***, void**,         MPI_Datatype, int*, int*, MPI_Comm);void read_block_vector(char*, void**, MPI_Datatype,         int*, MPI_Comm);void read_replicated_vector(char*, void**, MPI_Datatype,         int*, MPI_Comm);/**************** OUTPUT FUNCTIONS ***************/void print_submatrix(void**, MPI_Datatype, int, int);void print_subvector(void*, MPI_Datatype, int);void print_row_striped_matrix(void**, MPI_Datatype,         int, int, MPI_Comm);void print_col_striped_matrix(void**, MPI_Datatype,         int, int, MPI_Comm);void print_checkerboard_matrix(void**, MPI_Datatype,            int, int, MPI_Comm);void print_block_vector(void*, MPI_Datatype, int, MPI_Comm);void print_replicated_vector(void*, MPI_Datatype, int, MPI_Comm);

MyMPI.c

/* MyMPI.c -- A library of matrix/vector * input/output/redistribution functions. * * Programed by Michael J. Quinn * Last modification: 4 September 2002 * "Parallel Programming in C with MPI and OpenMP" * Typed and modified by xiu_dim, 17 Nov. 2015 */#include <mpi.h>#include <stdio.h>#include <stdlib.h>#include <string.h>#include "MyMPI.h"/************ MISCELLANEOUS FUNCTIONS ************//* * Given MPI_DataType 't', function 'get_size' returns the * size of a single datum that data type. */int get_size(MPI_Datatype t){    if (t == MPI_BYTE) return sizeof(char);    if (t == MPI_DOUBLE) return sizeof(double);    if (t == MPI_FLOAT) return sizeof(float);    if (t == MPI_INT) return sizeof(int);    printf("Error: Unrecognized argument to 'get_size'\n");    fflush(stdout);    MPI_Abort(MPI_COMM_WORLD, TYPE_ERROR);}/* * Function 'my_malloc' is called when a process wants * to allocate some space from the heap. If the memory * allocation fails, the process prints an error message * and then aborts execution of the program. */void *my_malloc(    int id,    /* IN - Process rank */    int bytes) /* IN - Bytes to allocate */{    void *buffer;    if ((buffer = malloc((size_t)bytes)) == NULL) {        printf("Error:Malloc failed for process %d\n", id);        fflush(stdout);        MPI_Abort(MPI_COMM_WORLD, MALLOC_ERROR);    }    return buffer;}/* * Function 'terminate' is called when the program should * not continue execution, due to an error conditon that * all of the processes are aware of. Process 0 prints the * error message passed as an argument to the function. *  * All processes must invoke this function together! */void terminate(    int id,              /* IN - Process rank */    char *error_message) /* IN - Message to print */{    if (!id) {        printf("Error: %s\n", error_message);        fflush(stdout);    }    MPI_Finalize();    exit(-1);}/********** DATA DISTRIBUTION FUNCTIONS **********//* * This function creates the count and displacement arrays * needed by scatter and gather functions, when the number * of elements send/received to/from other processes varies. */void create_mixed_xfer_arrays(    int id,      /* IN - Process rank */    int p,       /* IN - Number of processes */    int n,       /* IN - Total number of elements */    int **count, /* OUT - Array of counts */    int **disp)  /* OUT - Array of displacements */{    int i;    *count = my_malloc(id, p*sizeof(int));    *disp = my_malloc(id, p*sizeof(int));    (*count)[0] = BLOCK_SIZE(0,p,n);    (*disp)[0] = 0;    for (i=1; i<p; ++i) {        (*disp)[i] = (*disp)[i-1] + (*count)[i-1];        (*count)[i] = BLOCK_SIZE(i,p,n);    }    return;}/* * This function creates the count and displacement arrays * needed in an all-to-all exchange, when a process gets  * the same number of elements from every other process. */void create_uniform_xfer_arrays(    int id,      /* IN - Process rank */    int p,       /* IN - Number of processes */    int n,       /* IN - Total number of elements */    int **count, /* OUT - Array of counts */    int **disp)  /* OUT - Array of displacements */{    int i;    *count = my_malloc(id, p*sizeof(int));    *disp = my_malloc(id, p*sizeof(int));    (*count)[0] = BLOCK_SIZE(id,p,n);    (*disp)[0] = 0;    for (i=1; i<p; ++i) {        (*disp)[i] = (*disp)[i-1] + (*count)[i-1];        (*count)[i] = BLOCK_SIZE(id,p,n);    }    return;}/* * This function is used to transform a vector from a  * block distribution to a replicated distribution within   * a communicator. */void replicate_block_vector(    void *ablock,       /* IN - Block-distributed vector */    int n,              /* IN - Number of elements in vector */    void *arep,         /* OUT - Replicated vector */    MPI_Datatype dtype, /* IN - Vector element type */    MPI_Comm comm)      /* IN - Communicator */{    int p;     /* Number of processes */    int id;    /* Process rank */    int *cnt;  /* Number of elements contributed by each process */    int *disp; /* Displacement in concatenated array */    MPI_Comm_size(comm, &p);    MPI_Comm_rank(comm, &id);    create_mixed_xfer_arrays(id, p, n, &cnt, &disp);    MPI_Allgatherv(ablock, cnt[id], dtype, arep,             cnt, disp, dtype, comm);    free(cnt);    free(disp);    return;}/**************** INPUT FUNCTIONS ****************//* * In the matrix file, the first two elemnts are  * integers whose values are the dimensions of the  * matrix ('m' rows and 'n' columns). What follows  * are 'm'*'n' values representing the matrix elements  * stored in row-major order. *//* * Process p-1 opens a file and inputs a two-dimensional * matrix, reading and distributing blocks of rows to the * other MPI processes. */void read_row_striped_matrix(    char *s,            /* IN - File name */    void ***subs,       /* OUT - Submatrix row indices */    void **storage,     /* OUT - Submatrix stored here */    MPI_Datatype dtype, /* IN - Matrix element type */    int *m,             /* OUT - Number of rows in matrix */    int *n,             /* OUT - Number of cols in matrix */    MPI_Comm comm)      /* IN - Communicator */{    int p;             /* Number of processes */    int id;            /* Process rank */    int datum_size;    /* Size of matrix element */    int local_rows;    /* Number of rows in this process */    FILE *infileptr;   /* Input file poiter */    void **lptr;       /* Pointer into 'subs' */    void *rptr;        /* Pointer into 'storage' */    MPI_Status status; /* Result of receive */    int x;             /* Result of read */    int i;    MPI_Comm_size(comm, &p);    MPI_Comm_rank(comm, &id);    datum_size = get_size(dtype);    /* Process p-1 opens the file 's' */    if (id == p-1) {        infileptr = fopen(s, "r");        if (infileptr == NULL) *m = 0;        else {            x = fread(m, sizeof(int), 1, infileptr);            x = fread(n, sizeof(int), 1, infileptr);        }    }    /* Process p-1 broadcasts 'm' in communicator 'comm' */    MPI_Bcast(m, 1, MPI_INT, p-1, comm);    if (!(*m)) MPI_Abort(MPI_COMM_WORLD, OPEN_FILE_ERROR);    /* Process p-1 broadcasts 'n' in communicator 'comm' */    MPI_Bcast(n, 1, MPI_INT, p-1, comm);    /* Number of rows in this process */    local_rows = BLOCK_SIZE(id,p,*m);    /* Allocate array for submatrix in this process */    *storage = (void *)my_malloc(id,                             local_rows*(*n)*datum_size);    /* Allocate array for row indices in this pointers */    *subs = (void **)my_malloc(id, local_rows*PTR_SIZE);    /* Connet 'subs' with 'storage' */    lptr = (void *)&(*subs[0]);    rptr = (void *)*storage;    for (i=0; i<local_rows; ++i) {        *(lptr++) = (void *)rptr;        rptr += (*n) * datum_size;    }    if (id == (p-1)) {        for (i=0; i<p-1; ++i) {            /* Process p-1 reads datum from 'infileptr'                and sends it together with tag 'DATA_MSG'                to process i in communicator 'comm' */            x = fread(*storage, datum_size,                     BLOCK_SIZE(i,p,*m)*(*n), infileptr);            MPI_Send(*storage, BLOCK_SIZE(i,p,*m)*(*n),                     dtype, i, DATA_MSG, comm);        }        /* Process p-1 reads datum from 'infileptr' */        x = fread(*storage, datum_size,                     BLOCK_SIZE(i,p,*m)*(*n), infileptr);        fclose(infileptr);    } else        /* This process receives datum from process p-1 */        MPI_Recv(*storage, local_rows*(*n), dtype, p-1,                     DATA_MSG, comm, &status);    return;}/* * Process p-1 opens a file and inputs a two-dimensional * matrix, reading and distributing blocks of columns to  * the other MPI processes. */void read_col_striped_matrix(    char *s,            /* IN - File name */    void ***subs,       /* OUT - 2-D array */    void **storage,     /* OUT - Array elements */    MPI_Datatype dtype, /* IN - Matrix element type */    int *m,             /* OUT - Number of rows in matrix */    int *n,             /* OUT - Number of cols in matrix */    MPI_Comm comm)      /* IN - Communicator */{    int p;             /* Number of processes */    int id;            /* Process rank */    int datum_size;    /* Size of matrix element */    int local_cols;    /* Number of cols in this process */    FILE *infileptr;   /* Input file poiter */    void *buffer;      /* File buffer */    void **lptr;       /* Pointer into 'subs' */    void *rptr;        /* Pointer into 'storage' */    int *send_count;   /* Each process's count */    int *send_disp;    /* Each process's displacement */    int i,j;    MPI_Comm_size(comm, &p);    MPI_Comm_rank(comm, &id);    datum_size = get_size(dtype);    /* Process p-1 opens the file 's' */    if (id == (p-1)) {        infileptr = fopen(s, "r");        if (infileptr == NULL) *m = 0;        else {            fread(m, sizeof(int), 1, infileptr);            fread(n, sizeof(int), 1, infileptr);        }    }    /* Process p-1 broadcasts 'm' in communicator 'comm' */    MPI_Bcast(m, 1, MPI_INT, p-1, comm);    if (!(*m)) MPI_Abort(comm, OPEN_FILE_ERROR);    /* Process p-1 broadcasts 'n' in communicator 'comm' */    MPI_Bcast(n, 1, MPI_INT, p-1, comm);    /* Number of cols in this process */    local_cols = BLOCK_SIZE(id,p,*n);    /* Dynamically allocate two-dimensional matrix 'subs' */    /* Allocate array for submatrix in this process */    *storage = my_malloc(id, (*m)*local_cols*datum_size);    /* Allocate array for row indices in this pointers */    *subs = (void **)my_malloc(id, (*m)*PTR_SIZE);    lptr = (void *)*subs;    rptr = (void *)*storage;    for (i=0; i<(*m); ++i) {        *(lptr++) = (void *)rptr;        rptr += local_cols * datum_size;    }    if (id == (p-1))        buffer = my_malloc(id, (*n)*datum_size);    create_mixed_xfer_arrays(id, p, *n, &send_count, &send_disp);    for (i=0; i<(*m); ++i) {        if (id == (p-1))            fread(buffer, datum_size, *n, infileptr);        MPI_Scatterv(buffer, send_count, send_disp, dtype,             (*storage)+i*local_cols*datum_size,             local_cols, dtype, p-1, comm);    }    free(send_count);    free(send_disp);    if (id == (p-1)) free(buffer);    return;}/* * This function allocate blocks of the matrix to * the MPI processes. * * The number of processes MUST be a square number. */void read_checkerboard_matrix(    char *s,            /* IN - File name */    void ***subs,       /* OUT - 2-D array */    void **storage,     /* OUT - Array elements */    MPI_Datatype dtype, /* IN - Matrix element type */    int *m,             /* OUT - Number of rows in matrix */    int *n,             /* OUT - Number of cols in matrix */    MPI_Comm grid_comm)      /* IN - Communicator */{    int p;              /* Number of processes */    int grid_id;        /* Process rank in grid */    int datum_size;     /* Size of matrix element */    int coords[2];      /* Coords of process receiving next row of matrix */    int grid_coords[2]; /* Coords of this process */    int grid_period[2]; /* Wraparound */    int grid_size[2];   /* Dimemsions of process grid */    int local_rows;     /* Number of matrix rows in this process */    int local_cols;     /* Number of matrix cols in this process */    FILE *infileptr;    /* Input file poiter */    void *buffer;       /* File buffer */    void **lptr;        /* Pointer into 'subs' */    void *rptr;         /* Pointer into 'storage' */    void *laddr;        /* Used when process 0 gets row */    void *raddr;        /* Address of first element to send */    int dest_id;        /* Rank of receiving process */    MPI_Status status;  /* Result of receive */    int i,j,k;    MPI_Comm_size(grid_comm, &p);    MPI_Comm_rank(grid_comm, &grid_id);    datum_size = get_size(dtype);    /* Process 0 opens file, get numbers of rows and cols,        and broadcasts this information to the other processes */    if (grid_id == 0) {        infileptr = fopen(s, "r");        if (infileptr == NULL) *m = 0;        else {            fread(m, sizeof(int), 1, infileptr);            fread(n, sizeof(int), 1, infileptr);        }    }    MPI_Bcast(m, 1, MPI_INT, 0, grid_comm);    if (!(*m)) MPI_Abort(MPI_COMM_WORLD, OPEN_FILE_ERROR);    MPI_Bcast(n, 1, MPI_INT, 0, grid_comm);    /* Each process determines the size of the submatrix       it is responsible for. */    MPI_Cart_get(grid_comm, 2, grid_size,         grid_period, grid_coords);    local_rows = BLOCK_SIZE(grid_coords[0],grid_size[0],*m);    local_cols = BLOCK_SIZE(grid_coords[1],grid_size[1],*n);    /* Dynamicaly allocate two-dimensional matrix 'subs' */    *storage = my_malloc(grid_id,         local_rows*local_cols*datum_size);    *subs = (void **)my_malloc(grid_id, local_rows*PTR_SIZE);    lptr = (void *)*subs;    rptr = (void *)*storage;    for (i=0; i<local_rows; ++i) {        *(lptr++) = (void *)rptr;        rptr += local_cols * datum_size;    }    /* Grid process 0 reads in the matrix one row at a time        and distributes each row among the MPI processes */    if (grid_id == 0)        buffer = my_malloc(grid_id, (*n)*datum_size);    /* For each row of processes in the process grid */    for (i=0; i<grid_size[0]; ++i) {        coords[0] = i;        /* For each matrix row controlled by this process row */        for (j=0; j<BLOCK_SIZE(i,grid_size[0],*m); ++j) {            /* Read in a row of the matrix */            if (grid_id == 0) {                fread(buffer, datum_size, *n, infileptr);            }            /* Distribute it among processes in the grid row */            for (k=0; k<grid_size[1]; ++k) {                coords[1] = k;                /* Find address of first element to send */                raddr = buffer +                     BLOCK_LOW(k,grid_size[1],*n) * datum_size;                /* Determine the grid ID of the process                   getting the subrow */                MPI_Cart_rank(grid_comm, coords, &dest_id);                if (grid_id == 0) {                /* Process 0 is responsible for sending */                    if (dest_id == 0) {                    /* It is sending(copying) to itself */                        laddr = (*subs)[j];                        memcpy(laddr, raddr,                             local_cols*datum_size);                    } else {                    /* It is sending to another process */                        MPI_Send(raddr,                             BLOCK_SIZE(k,grid_size[1],*n),                             dtype, dest_id, 0, grid_comm);                    }                } else if (grid_id == dest_id) {                /* Process 'dest_id' is responsible for receiving */                    MPI_Recv((*subs)[j], local_cols, dtype,                         0, 0, grid_comm, &status);                }            }        }    }    if (grid_id == 0) free(buffer);    return;}/* * Process p-1 opens a file containing a vector, reads  * its contents, and distributes the elements by block * among the processes in a communicator. */void read_block_vector(    char *s,            /* IN - File name */    void **v,           /* OUT - Subvector */    MPI_Datatype dtype, /* IN - Vector element type */    int *n,             /* OUT - Vector length */    MPI_Comm comm)      /* IN - Communicator */{    int p;             /* Number of processes */    int id;            /* Process rank */    int datum_size;    /* Size of vector element */    int local_els;     /* Number of elements in this process */    FILE *infileptr;   /* Input file poiter */    MPI_Status status; /* Result of receive */    int x;             /* Result of read */    int i;    MPI_Comm_size(comm,&p);    MPI_Comm_rank(comm, &id);    datum_size = get_size(dtype);    /* Process p-1 opens file, determines number of vector       elements, and broadcasts this value to the other        processes */    if (id == (p-1)) {        infileptr = fopen(s, "r");        if (infileptr == NULL) *n = 0;        else fread(n, sizeof(int), 1, infileptr);    }    MPI_Bcast(n, 1, MPI_INT, p-1, comm);    if (!(*n)) {        if (!id) {            printf("Input file '%s' cannot be opened\n", s);            fflush(stdout);        }    }    /* Block mapping of vetor elements to processes */    local_els = BLOCK_SIZE(id,p,*n);     *v = my_malloc(id, local_els*datum_size);     if (id == (p-1)) {         for (i=0; i<p-1; ++i) {             x = fread(*v, datum_size, BLOCK_SIZE(i,p,*n),                     infileptr);             MPI_Send(*v, BLOCK_SIZE(i,p,*n), dtype, i,                     DATA_MSG, comm);         }         x = fread(*v, datum_size, BLOCK_SIZE(id,p,*n),                 infileptr);         fclose(infileptr);     } else {         MPI_Recv(*v, BLOCK_SIZE(id,p,*n), dtype, p-1,                 DATA_MSG, comm, &status);      }    return;}/* * Process p-1 opens a file containing a vector, reads its  * contents, and replicates the vector among all processes * in a communicator. */void read_replicated_vector(    char *s,            /* IN - File name */    void **v,           /* OUT - Subvector */    MPI_Datatype dtype, /* IN - Vector element type */    int *n,             /* OUT - Vector length */    MPI_Comm comm)      /* IN - Communicator */{    int p;             /* Number of processes */    int id;            /* Process rank */    int datum_size;    /* Size of vector element */    FILE *infileptr;   /* Input file poiter */    int i;    /* Process p-1 opens file, determines number of vector       elements, and broadcasts this value to the other        processes */    MPI_Comm_size(comm, &p);    MPI_Comm_rank(comm, &id);    datum_size = get_size(dtype);    if (id == (p-1)) {        infileptr = fopen(s, "r");        if (infileptr == NULL) *n = 0;        else fread(n, sizeof(int), 1, infileptr);    }    MPI_Bcast(n, 1, MPI_INT, p-1, comm);    if (!(*n)) terminate(id, "Cannot open vector file!");    *v = my_malloc(id, (*n)*datum_size);    if (id == (p-1)) {        fread(*v, datum_size, *n, infileptr);        fclose(infileptr);    }    MPI_Bcast(*v, *n, dtype, p-1, MPI_COMM_WORLD);    return;}/**************** OUTPUT FUNCTIONS ***************//* * Print elements of a doubly subscripted array. */void print_submatrix(    void **a,           /* IN - Doubly subscripted array */    MPI_Datatype dtype, /* IN - Type of element */    int rows,           /* IN - Number of rows */    int cols)           /* IN - Number of columns */{    int i,j;    for (i=0; i<rows; ++i) {        for (j=0; j<cols; ++j) {            if (dtype == MPI_DOUBLE)                printf("%6.3f",((double **)a)[i][j]);            else {                if (dtype == MPI_FLOAT)                    printf("%6.3f",((float **)a)[i][j]);                else                    printf("%6d",((int **)a)[i][j]);            }        }        putchar('\n');    }    return;}/* * Print elements of a singly subscripted array. */void print_subvector(    void *a,            /* IN - Singly subscripted array */    MPI_Datatype dtype, /* IN - Type of elements */    int n)              /* IN - Size of array */{    int i;    for (i=0; i<n; ++i) {        if (dtype == MPI_DOUBLE)            printf("%6.3f ",((double *)a)[i]);        else {            if (dtype == MPI_FLOAT)                printf("%6.3f ",((float *)a)[i]);            else if (dtype == MPI_INT)                printf("%6d ",((int *)a)[i]);        }    }    return;}/*  * Process 0 prints a matrix that is distributed in row- * striped fashion among the processes in a communicator. */void print_row_striped_matrix(    void **a,           /* IN - 2D array */    MPI_Datatype dtype, /* IN - Matrix element type */    int m,              /* IN - Number of matrix rows */    int n,              /* IN - Number of matrix columns */    MPI_Comm comm)      /* IN - Communicator */{    int p;              /* Number of processes */    int id;             /* Process rank */    int datum_size;     /* Size of matrix element */    int local_rows;     /* Rows in this process */    int max_block_size; /* Most matrix rows held by any process */    void *bstorage;     /* Elements received from another process */    void **b;           /* 2D array indexing into 'bstorage' */    MPI_Status status;  /* Result of receive */    int prompt;         /* Dummy variable */    int i;    MPI_Comm_size(comm, &p);        MPI_Comm_rank(comm, &id);    datum_size = get_size(dtype);    local_rows = BLOCK_SIZE(id,p,n);    if (!id) {        print_submatrix(a, dtype, local_rows, n);        if (p >1) {            max_block_size = BLOCK_SIZE(p-1,p,m);            bstorage = (void *)my_malloc(id,                             max_block_size*n*datum_size);            b = (void **)my_malloc(id,                             max_block_size*PTR_SIZE);            b[0] = bstorage;            for (i=1; i<max_block_size; ++i) {                b[i] = b[i-1] + n * datum_size;            }            for (i=1; i<p; ++i) {                /* Send a prompt message to process i                     in the default communicator */                MPI_Send(&prompt, 1, MPI_INT, i,                             PROMPT_MSG, MPI_COMM_WORLD);                /* Receive datum with tag 'RESPONSE_MSG' from                      process i in the default communicator */                MPI_Recv(bstorage, BLOCK_SIZE(i,p,m)*n, dtype,                    i, RESPONSE_MSG, MPI_COMM_WORLD, &status);                print_submatrix(b, dtype, BLOCK_SIZE(i,p,m), n);            }            free(b);            free(bstorage);        }        putchar('\n');    } else {        /* Receive a prompt message from process 0             in the default communicator */        MPI_Recv(&prompt, 1, MPI_INT, 0, PROMPT_MSG,                     MPI_COMM_WORLD,&status);        /* Send datum with tag 'RESPONSE_MSG' to process 0            in the default communicator */        MPI_Send(*a, local_rows*n, dtype, 0, RESPONSE_MSG,                     MPI_COMM_WORLD);    }    return;}/*  * Process 0 prints a matrix that has a  * columnwise-block-striped data decompsition  * among the processes in a communicator. */void print_col_striped_matrix(    void **a,           /* IN - 2D array */    MPI_Datatype dtype, /* IN - Matrix element type */    int m,              /* IN - Number of matrix rows */    int n,              /* IN - Number of matrix columns */    MPI_Comm comm)      /* IN - Communicator */{    int p;              /* Number of processes */    int id;             /* Process rank */    int datum_size;     /* Size of matrix element */    void *buffer;       /* Buffer to hold one row */    int *rec_count;     /* Number of elements received per process */    int *rec_disp;      /* Offset of each process's block */    MPI_Status status;  /* Result of receive */    int i,j;    MPI_Comm_size(comm, &p);    MPI_Comm_rank(comm, &id);    datum_size = get_size(dtype);    create_mixed_xfer_arrays(id, p, n, &rec_count, &rec_disp);    if (!id) buffer = my_malloc(id, n*datum_size);    for (i=0; i<m; ++i) {        MPI_Gatherv(a[i], BLOCK_SIZE(id,p,n), dtype, buffer,            rec_count, rec_disp, dtype, 0, MPI_COMM_WORLD);        if (!id) {            print_subvector(buffer, dtype, n);            putchar('\n');        }    }    free(rec_count);    free(rec_disp);    if (!id) {        free(buffer);        putchar('n');    }    return;}/* * This function prints a matrix distributed checkerboard * fashion among the processes in a communicator. */void print_checkerboard_matrix(    void **a,           /* IN - 2D array */    MPI_Datatype dtype, /* IN - Matrix element type */    int m,              /* IN - Number of matrix rows */    int n,              /* IN - Number of matrix columns */    MPI_Comm grid_comm) /* IN - Communicator */{    int p;              /* Number of processes */    int grid_id;        /* Process rank in grid */    int datum_size;     /* Size of matrix element */    int coords[2];      /* Grid coords of process sending elements */    int grid_coords[2]; /* Coords of this process */    int grid_period[2]; /* Wraparound */    int grid_size[2];   /* Dimemsions of process grid */    int local_cols;     /* Number of matrix cols in this process */    int els;            /* Element received */    int src;            /* ID of process with subrow */    void *buffer;       /* Buffer to hold one matrix row */    void *laddr;        /* Address to put subrow */    MPI_Status status;  /* Result of receive */    int i,j,k;    MPI_Comm_size(grid_comm, &p);    MPI_Comm_rank(grid_comm, &grid_id);    datum_size = get_size(dtype);    MPI_Cart_get(grid_comm, 2, grid_size,         grid_period, grid_coords);    local_cols = BLOCK_SIZE(grid_coords[1],grid_size[1],n);    if (!grid_id)         buffer = my_malloc(grid_id, n*datum_size);    /* For each row of the process grid */    for (i=0; i<grid_size[0]; ++i) {        coords[0] = i;        /* For each matrix row controlled by the process row*/        for (j=0; j<BLOCK_SIZE(i,grid_size[0],m); ++j) {            /* Collect the matrix row on grid process 0 and                print it */            if (!grid_id) {                for (k=0; k<grid_size[1]; ++k) {                    coords[1] = k;                    MPI_Cart_rank(grid_comm, coords, &src);                    els = BLOCK_SIZE(k,grid_size[1],n);                    laddr = buffer +                         BLOCK_LOW(k,grid_size[1],n) * datum_size;                    if (src == 0) {                        memcpy(laddr, a[j], els*datum_size);                    } else {                        MPI_Recv(laddr, els, dtype, src, 0,                             grid_comm, &status);                    }                }                print_subvector(buffer, dtype, n);                putchar('\n');            } else if (grid_coords[0] == i) {                MPI_Send(a[j], local_cols, dtype, 0, 0, grid_comm);            }        }    }    if (!grid_id) {        free(buffer);        putchar('\n');    }    return;}/* * Process 0 prints a vector that is block distributed   * among the processes in a communicator. */void print_block_vector(    void *v,            /* IN - Address of vector */    MPI_Datatype dtype, /* IN - Vector element type */    int n,              /* IN - Vector length */    MPI_Comm comm)      /* IN - Communicator */{    int p;              /* Number of processes */    int id;             /* Process rank */    int datum_size;     /* Size of vector element */    void *tmp;          /* Other process's subvector */    MPI_Status status;  /* Result of receive */    int prompt;         /* Dummy variable */    int i;    MPI_Comm_size(comm, &p);    MPI_Comm_rank(comm, &id);    datum_size = get_size(dtype);    if (!id) {        print_subvector(v, dtype, BLOCK_SIZE(id,p,n));        if (p>1) {            tmp = my_malloc(id,                     BLOCK_SIZE(p-1,p,n)*datum_size);            for (i=1; i<p; ++i) {                MPI_Send(&prompt, 1, MPI_INT, i,                     PROMPT_MSG, comm);                MPI_Recv(tmp, BLOCK_SIZE(i,p,n), dtype, i,                     RESPONSE_MSG, comm, &status);                print_subvector(tmp, dtype,                     BLOCK_SIZE(i,p,n));            }            free(tmp);        }        printf("\n\n");    } else {        MPI_Recv(&prompt, 1, MPI_INT, 0, PROMPT_MSG,             comm, &status);        MPI_Send(v, BLOCK_SIZE(id,p,n), dtype, 0,             RESPONSE_MSG, comm);    }    return;}/* * Process 0 prints a vector that is replicated among  * the processes in a communicator. */void print_replicated_vector(    void *v,            /* IN - Address of vector */    MPI_Datatype dtype, /* IN - Vector element type */    int n,              /* IN - Vector length */    MPI_Comm comm)      /* IN - Communicator */{    int id; /* Process rank */    MPI_Comm_rank(comm, &id);    if (!id) {        print_subvector(v, dtype, n);        printf("\n\n");    }    return;}