int main(int argc, char *argv[])
{
int nprocs, i, pmode;
char *win_buf;
MTest_Init_thread(&argc, &argv, MPI_THREAD_MULTIPLE, &pmode);
if (pmode != MPI_THREAD_MULTIPLE) {
fprintf(stderr, "Thread Multiple not supported by the MPI implementation\n");
MPI_Abort(MPI_COMM_WORLD, -1);
}
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
if (nprocs < 2) {
printf("Run this program with 2 or more processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
errs += MPI_Win_allocate(COUNT * sizeof(int), sizeof(int), MPI_INFO_NULL, MPI_COMM_WORLD, &win_buf, &win);
errs += MPI_Win_lock_all(0, win);
for (i = 0; i < NUM_THREADS; i++)
errs += MTest_Start_thread(run_test, NULL);
errs += MTest_Join_threads();
errs += MPI_Win_unlock_all(win);
errs += MPI_Win_free(&win);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
dart_ret_t dart_team_destroy(
dart_team_t teamid)
{
MPI_Comm comm;
MPI_Win win;
uint16_t index;
dart_unit_t id;
int result = dart_adapt_teamlist_convert(teamid, &index);
if (result == -1) {
return DART_ERR_INVAL;
}
comm = dart_teams[index];
dart_myid (&id);
// free (dart_unit_mapping[index]);
// MPI_Win_free (&(sharedmem_win_list[index]));
#if !defined(DART_MPI_DISABLE_SHARED_WINDOWS)
free(dart_sharedmem_table[index]);
#endif
win = dart_win_lists[index];
MPI_Win_unlock_all(win);
MPI_Win_free(&win);
dart_adapt_teamlist_recycle(index, result);
/* -- Release the communicator associated with teamid -- */
MPI_Comm_free (&comm);
DART_LOG_DEBUG("%2d: TEAMDESTROY - destroy team %d", id, teamid);
return DART_OK;
}
int main (int argc, char *argv[])
{
struct pe_vars v;
long * msg_buffer;
/*
* Initialize
*/
init_mpi(&v);
check_usage(argc, argv, v.npes, v.me);
print_header(v.me);
if (v.me == 0) printf("Total processes = %d\n",v.npes);
/*
* Allocate Memory
*/
msg_buffer = allocate_memory(v.me, &(v.win) );
memset(msg_buffer, 0, MAX_MSG_SZ * ITERS_LARGE * sizeof(long));
/*
* Time Put Message Rate
*/
benchmark(msg_buffer, v.me, v.pairs, v.nxtpe, v.win);
/*
* Finalize
*/
MPI_Win_unlock_all(v.win);
MPI_Win_free(&v.win);
MPI_Free_mem(msg_buffer);
MPI_Finalize();
return EXIT_SUCCESS;
}
/*Run FOP with Lock_all/unlock_all */
void run_fop_with_lock_all (int rank, WINDOW type)
{
int i;
MPI_Aint disp = 0;
MPI_Win win;
allocate_atomic_memory(rank, sbuf_original, rbuf_original,
tbuf_original, NULL, (char **)&sbuf, (char **)&rbuf,
(char **)&tbuf, NULL, (char **)&rbuf, MAX_MSG_SIZE, type, &win);
if(rank == 0) {
if (type == WIN_DYNAMIC) {
disp = disp_remote;
}
for (i = 0; i < skip + loop; i++) {
if (i == skip) {
t_start = MPI_Wtime ();
}
MPI_CHECK(MPI_Win_lock_all(0, win));
MPI_CHECK(MPI_Fetch_and_op(sbuf, tbuf, MPI_LONG_LONG, 1, disp, MPI_SUM, win));
MPI_CHECK(MPI_Win_unlock_all(win));
}
t_end = MPI_Wtime ();
}
MPI_CHECK(MPI_Barrier(MPI_COMM_WORLD));
print_latency(rank, 8);
free_atomic_memory (sbuf, rbuf, tbuf, NULL, win, rank);
}
void _XMP_mpi_coarray_deallocate(_XMP_coarray_t *c, bool is_acc)
{
if(_XMP_flag_multi_win){
MPI_Win_unlock_all(c->win);
_XMP_barrier_EXEC();
_XMP_mpi_onesided_dealloc_win(&(c->win), (void **)&(c->real_addr), is_acc);
}
}
void destroy_safe_array()
{
int rc;
MP_BARRIER();
MPI_Win_unlock_all(win);
MPI_Win_free(&win);
MP_BARRIER();
}
int main(int argc, char **argv)
{
int rank, size;
MPI_Win win = MPI_WIN_NULL;
int *baseptr = NULL;
int errs = 0, mpi_errno = MPI_SUCCESS;
int val1 = 0, val2 = 0, flag = 0;
MPI_Request reqs[2];
MPI_Status stats[2];
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
MPI_Win_allocate(2 * sizeof(int), sizeof(int), MPI_INFO_NULL, MPI_COMM_WORLD, &baseptr, &win);
/* Initialize window buffer */
MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
baseptr[0] = 1;
baseptr[1] = 2;
MPI_Win_unlock(rank, win);
MPI_Barrier(MPI_COMM_WORLD);
/* Issue request-based get with testall. */
MPI_Win_lock_all(0, win);
MPI_Rget(&val1, 1, MPI_INT, 0, 0, 1, MPI_INT, win, &reqs[0]);
MPI_Rget(&val2, 1, MPI_INT, 0, 1, 1, MPI_INT, win, &reqs[1]);
do {
mpi_errno = MPI_Testall(2, reqs, &flag, stats);
} while (flag == 0);
/* Check get value. */
if (val1 != 1 || val2 != 2) {
printf("%d - Got val1 = %d, val2 = %d, expected 1, 2\n", rank, val1, val2);
fflush(stdout);
errs++;
}
/* Check return error code. */
if (mpi_errno != MPI_SUCCESS) {
printf("%d - Got return errno %d, expected MPI_SUCCESS(%d)\n",
rank, mpi_errno, MPI_SUCCESS);
fflush(stdout);
errs++;
}
MPI_Win_unlock_all(win);
MPI_Barrier(MPI_COMM_WORLD);
MPI_Win_free(&win);
MTest_Finalize(errs);
MPI_Finalize();
return errs != 0;
}
void _XMP_mpi_coarray_deregmem(_XMP_coarray_t *c)
{
if(! _XMP_flag_multi_win){
_XMP_fatal("single window mode does not support coarray deregmem");
}
MPI_Win_unlock_all(c->win);
_XMP_barrier_EXEC();
_XMP_mpi_onesided_destroy_win(&(c->win));
}
/* garray_destroy()
*/
void garray_destroy(garray_t *ga)
{
garray_flush(ga);
MPI_Win_unlock_all(ga->win);
MPI_Win_free(&ga->win);
free(ga->dims);
LOG_INFO(ga->g->glog, "[%d] garray destroyed %ld-array, element size %ld\n",
ga->g->nid, ga->ndims, ga->elem_size);
free(ga);
}
/** Free an MCS mutex. Collective on ranks in the communicator used at the
* time of creation.
*
* @param[in] hdl handle to the group that will be freed
* @return MPI status
*/
int MCS_Mutex_free(MCS_Mutex * hdl_ptr)
{
MCS_Mutex hdl = *hdl_ptr;
MPI_Win_unlock_all(hdl->window);
MPI_Win_free(&hdl->window);
MPI_Comm_free(&hdl->comm);
free(hdl);
hdl_ptr = NULL;
return MPI_SUCCESS;
}
int main(int argc, char **argv){
int i, me, target;
unsigned int size;
double t, t_max;
MPI_Win win;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &me);
MPI_Win_create(&send_buf, sizeof(char)*MAX_SIZE, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win);
target = 1 - me;
MPI_Win_lock_all(0, win);
init_buf(send_buf, me);
if(me==0) print_items();
for(size=1;size<MAX_SIZE+1;size*=2){
MPI_Barrier(MPI_COMM_WORLD);
for(i=0;i<LOOP+WARMUP;i++){
if(WARMUP == i)
t = wtime();
if(me == 0){
MPI_Put(send_buf, size, MPI_CHAR, target, 0, size, MPI_CHAR, win);
MPI_Win_flush_local(target, win);
while(send_buf[0] == '0' || send_buf[size-1] == '0'){ MPI_Win_flush(me, win); }
send_buf[0] = '0'; send_buf[size-1] = '0';
}
else {
while(send_buf[0] == '1' || send_buf[size-1] == '1'){ MPI_Win_flush(me, win); }
send_buf[0] = '1'; send_buf[size-1] = '1';
MPI_Put(send_buf, size, MPI_CHAR, target, 0, size, MPI_CHAR, win);
MPI_Win_flush_local(target, win);
}
} //end of LOOP
t = wtime() - t;
MPI_Reduce(&t, &t_max, 1, MPI_DOUBLE, MPI_MAX, 0, MPI_COMM_WORLD);
if(me == 0)
print_results(size, t_max);
}
MPI_Win_unlock_all(win);
MPI_Win_free(&win);
MPI_Finalize();
return 0;
}
int main(int argc, char * argv[])
{
MPI_Init(&argc, &argv);
int wrank, wsize;
MPI_Comm_rank(MPI_COMM_WORLD, &wrank);
MPI_Comm_size(MPI_COMM_WORLD, &wsize);
int nrank, nsize;
MPI_Comm MPI_COMM_NODE;
MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0 /* key */, MPI_INFO_NULL, &MPI_COMM_NODE);
MPI_Comm_rank(MPI_COMM_NODE, &nrank);
MPI_Comm_size(MPI_COMM_NODE, &nsize);
int * shptr = NULL;
MPI_Win shwin;
MPI_Info win_info;
MPI_Info_create(&win_info);
MPI_Info_set(win_info, "alloc_shared_noncontig", "true");
MPI_Win_allocate_shared(sizeof(int), sizeof(int), win_info, MPI_COMM_NODE, &shptr, &shwin);
MPI_Info_free(&win_info);
MPI_Win_lock_all(0 /* assertion */, shwin);
MPI_Win_sync(shwin);
MPI_Barrier(MPI_COMM_NODE);
MPI_Aint rsize[nsize];
int rdisp[nsize];
int * rptr[nsize];
for (int i=0; i<nsize; i++) {
MPI_Win_shared_query(shwin, i, &(rsize[i]), &(rdisp[i]), &(rptr[i]));
printf("rank=%d target=%d rptr=%p rsize=%zu rdisp=%d \n", nrank, i, rptr[i], (size_t)rsize[i], rdisp[i]);
}
MPI_Win_unlock_all(shwin);
MPI_Win_free(&shwin);
MPI_Comm_free(&MPI_COMM_NODE);
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int errs = 0;
int rank, nprocs, i, pmode;
double *win_mem;
MTest_Init_thread(&argc, &argv, MPI_THREAD_MULTIPLE, &pmode);
if (pmode != MPI_THREAD_MULTIPLE) {
fprintf(stderr, "MPI_THREAD_MULTIPLE is not supported\n");
MPI_Abort(MPI_COMM_WORLD, -1);
}
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
if (nprocs < 2) {
printf("Run this program with 2 or more processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
if (rank == 0) {
errs += MPI_Win_allocate(COUNT * sizeof(double), sizeof(double),
MPI_INFO_NULL, MPI_COMM_WORLD, &win_mem, &win);
} else {
errs += MPI_Win_allocate(0, sizeof(double), MPI_INFO_NULL,
MPI_COMM_WORLD, &win_mem, &win);
}
errs += MPI_Win_lock_all(0, win);
for (i = 0; i < NUM_THREADS; i++)
errs += MTest_Start_thread(run_test, NULL);
errs += MTest_Join_threads();
errs += MPI_Win_unlock_all(win);
errs += MPI_Win_free(&win);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int SMP_Bcast(void* buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm)
{
int nrank = -1;
MPI_Comm_rank(comm, &nrank);
#ifndef DEBUG
int nsize = 0;
MPI_Comm_size(comm, &nsize);
/* fast path for trivial case */
if (nsize==1) return MPI_SUCCESS;
#endif
/* Type_size only works for types without holes. */
int ts = 0;
MPI_Type_size(datatype, &ts);
MPI_Aint winsize = (nrank==0) ? count * ts : 0;
void * local = NULL;
MPI_Win wintemp = MPI_WIN_NULL;
MPI_Win_allocate_shared(winsize, ts, MPI_INFO_NULL, comm, &local, &wintemp);
void * remote = NULL;
int disp; /* unused */
MPI_Win_shared_query(wintemp, 0, &winsize, &disp, &remote);
MPI_Win_lock_all(0, wintemp);
if (nrank==0) {
memcpy(local, buffer, (size_t)count*ts);
}
MPI_Win_sync(wintemp);
if (nrank!=0) {
memcpy(buffer, remote, (size_t)count*ts);
}
MPI_Win_unlock_all(wintemp);
MPI_Win_free(&wintemp);
return MPI_SUCCESS;
}
/*Run Get_accumulate with Lock_all/unlock_all */
void run_get_acc_with_lock_all(int rank, WINDOW type)
{
int size, i;
MPI_Aint disp = 0;
MPI_Win win;
for (size = 0; size <= MAX_SIZE; size = (size ? size * 2 : size + 1)) {
allocate_memory(rank, rbuf, size, type, &win);
if (type == WIN_DYNAMIC) {
disp = sdisp_remote;
}
if(size > LARGE_MESSAGE_SIZE) {
loop = LOOP_LARGE;
skip = SKIP_LARGE;
}
if(rank == 0) {
for (i = 0; i < skip + loop; i++) {
if (i == skip) {
t_start = MPI_Wtime ();
}
MPI_CHECK(MPI_Win_lock_all(0, win));
MPI_CHECK(MPI_Get_accumulate(sbuf, size, MPI_CHAR, cbuf, size, MPI_CHAR, 1, disp, size,
MPI_CHAR, MPI_SUM, win));
MPI_CHECK(MPI_Win_unlock_all(win));
}
t_end = MPI_Wtime ();
}
MPI_CHECK(MPI_Barrier(MPI_COMM_WORLD));
print_latency(rank, size);
MPI_Win_free(&win);
}
}
void _XMP_mpi_coarray_detach(_XMP_coarray_t *coarray_desc, const bool is_acc)
{
if(_XMP_flag_multi_win){
MPI_Win win = is_acc? coarray_desc->win_acc : coarray_desc->win;
MPI_Win_unlock_all(win);
_XMP_barrier_EXEC();
_XMP_mpi_onesided_destroy_win(&win);
}else{
MPI_Win win = _xmp_mpi_distarray_win;
void *real_addr = coarray_desc->real_addr;
#ifdef _XMP_XACC
if(is_acc){
win = _xmp_mpi_distarray_win_acc;
real_addr = coarray_desc->real_addr_dev;
}
#endif
MPI_Win_detach(win, real_addr);
}
if(is_acc){
#ifdef _XMP_XACC
_XMP_free(coarray_desc->addr_dev); //FIXME may be wrong
coarray_desc->addr_dev = NULL;
coarray_desc->real_addr_dev = NULL;
coarray_desc->win_acc = MPI_WIN_NULL;
coarray_desc->nodes = NULL;
#endif
}else{
_XMP_free(coarray_desc->addr);
coarray_desc->addr = NULL;
coarray_desc->real_addr = NULL;
coarray_desc->win = MPI_WIN_NULL;
coarray_desc->nodes = NULL;
}
}
void oshmpi_deallock(void)
{
MPI_Win_unlock_all (oshmpi_lock_win);
MPI_Win_free (&oshmpi_lock_win);
return;
}
void run_rma_test(int nprocs_per_node)
{
int myrank, nprocs;
int mem_rank;
MPI_Win win;
int *baseptr;
MPI_Aint local_size;
MPI_Comm_rank(MPI_COMM_WORLD, &myrank);
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
if (nprocs < nprocs_per_node * 2)
{
if (!myrank) printf("should start program with at least %d processes\n", nprocs_per_node * 2);
MPI_Finalize();
exit(EXIT_FAILURE);
}
mem_rank = nprocs_per_node + nprocs_per_node / 2;
local_size = (myrank == mem_rank) ? COUNT : 0;
MPI_Win_create_dynamic(MPI_INFO_NULL, MPI_COMM_WORLD, &win);
MPI_Win_lock_all(0, win);
int type_size;
MPI_Type_size(MPI_INT, &type_size);
size_t nbytes = COUNT * type_size;
assert(MPI_Alloc_mem(nbytes, MPI_INFO_NULL, &baseptr) == MPI_SUCCESS);
assert(MPI_Win_attach(win, baseptr, nbytes) == MPI_SUCCESS);
MPI_Aint ldisp;
MPI_Aint *disps = malloc(nprocs * sizeof(MPI_Aint));
assert(MPI_Get_address(baseptr, &ldisp) == MPI_SUCCESS);
assert(MPI_Allgather(&ldisp, 1, MPI_AINT, disps, nprocs, MPI_AINT, MPI_COMM_WORLD) == MPI_SUCCESS);
if (myrank == 0)
{
for (size_t idx = 0; idx < COUNT; ++idx) {
baseptr[idx] = idx * COUNT + 1;
}
}
MPI_Barrier(MPI_COMM_WORLD);
if (myrank == mem_rank) {
assert(MPI_Get(baseptr, 10, MPI_INT, 0, disps[0], 10, MPI_INT, win) == MPI_SUCCESS);
assert(MPI_Win_flush(0, win) == MPI_SUCCESS);
for (size_t idx = 0; idx < COUNT; ++idx) {
assert(baseptr[idx] == idx * 10 + 1);
}
}
MPI_Barrier(MPI_COMM_WORLD);
MPI_Win_unlock_all(win);
MPI_Barrier(MPI_COMM_WORLD);
MPI_Win_free(&win);
MPI_Free_mem(baseptr);
printf("Test finished\n");
}
int main(int argc, char ** argv)
{
int Block_order;
size_t Block_size;
size_t Colblock_size;
int Tile_order=32;
int tiling;
int Num_procs; /* Number of ranks */
int order; /* overall matrix order */
int send_to, recv_from; /* communicating ranks */
size_t bytes; /* total amount of data to be moved */
int my_ID; /* rank */
int root=0; /* root rank of a communicator */
int iterations; /* number of times to run the pipeline algorithm */
int i, j, it, jt, ID;/* dummies */
int iter; /* index of iteration */
int phase; /* phase in the staged communication */
size_t colstart; /* sequence number of first column owned by calling rank */
int error=0; /* error flag */
double *A_p; /* original matrix column block */
double *B_p; /* transposed matrix column block */
double *Work_in_p; /* workspace for the transpose function */
double *Work_out_p;/* workspace for the transpose function */
double abserr, abserr_tot; /* computed error */
double epsilon = 1.e-8; /* error tolerance */
double local_trans_time, /* timing parameters */
trans_time,
avgtime;
MPI_Status status; /* completion status of message */
MPI_Win shm_win_A; /* Shared Memory window object */
MPI_Win shm_win_B; /* Shared Memory window object */
MPI_Win shm_win_Work_in; /* Shared Memory window object */
MPI_Win shm_win_Work_out; /* Shared Memory window object */
MPI_Info rma_winfo;/* info for window */
MPI_Comm shm_comm_prep;/* Shared Memory prep Communicator */
MPI_Comm shm_comm; /* Shared Memory Communicator */
int shm_procs; /* # of ranks in shared domain */
int shm_ID; /* MPI rank within coherence domain */
int group_size; /* number of ranks per shared memory group */
int Num_groups; /* number of shared memory group */
int group_ID; /* sequence number of shared memory group */
int size_mul; /* size multiplier; 0 for non-root ranks in coherence domain*/
int istart;
MPI_Request send_req, recv_req;
/*********************************************************************************
** Initialize the MPI environment
**********************************************************************************/
MPI_Init(&argc,&argv);
MPI_Comm_rank(MPI_COMM_WORLD, &my_ID);
MPI_Comm_size(MPI_COMM_WORLD, &Num_procs);
root = 0;
/*********************************************************************
** process, test and broadcast input parameter
*********************************************************************/
if (my_ID == root){
if (argc != 4 && argc !=5){
printf("Usage: %s <#ranks per coherence domain> <# iterations> <matrix order> [tile size]\n",
*argv);
error = 1;
goto ENDOFTESTS;
}
group_size = atoi(*++argv);
if (group_size < 1) {
printf("ERROR: # ranks per coherence domain must be >= 1 : %d \n",group_size);
error = 1;
goto ENDOFTESTS;
}
if (Num_procs%group_size) {
printf("ERROR: toal # %d ranks not divisible by ranks per coherence domain %d\n",
Num_procs, group_size);
error = 1;
goto ENDOFTESTS;
}
iterations = atoi(*++argv);
if (iterations < 1){
printf("ERROR: iterations must be >= 1 : %d \n",iterations);
error = 1;
goto ENDOFTESTS;
}
order = atoi(*++argv);
if (order < Num_procs) {
printf("ERROR: matrix order %d should at least # procs %d\n",
order, Num_procs);
error = 1; goto ENDOFTESTS;
}
if (order%Num_procs) {
printf("ERROR: matrix order %d should be divisible by # procs %d\n",
order, Num_procs);
error = 1; goto ENDOFTESTS;
}
if (argc == 5) Tile_order = atoi(*++argv);
ENDOFTESTS:;
}
bail_out(error);
/* Broadcast input data to all ranks */
MPI_Bcast(&order, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast(&iterations, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast(&Tile_order, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast(&group_size, 1, MPI_INT, root, MPI_COMM_WORLD);
if (my_ID == root) {
printf("Parallel Research Kernels version %s\n", PRKVERSION);
printf("MPI+SHM Matrix transpose: B = A^T\n");
printf("Number of ranks = %d\n", Num_procs);
printf("Rank group size = %d\n", group_size);
printf("Matrix order = %d\n", order);
printf("Number of iterations = %d\n", iterations);
if ((Tile_order > 0) && (Tile_order < order))
printf("Tile size = %d\n", Tile_order);
else printf("Untiled\n");
#ifndef SYNCHRONOUS
printf("Non-");
#endif
printf("Blocking messages\n");
}
/* Setup for Shared memory regions */
/* first divide WORLD in groups of size group_size */
MPI_Comm_split(MPI_COMM_WORLD, my_ID/group_size, my_ID%group_size, &shm_comm_prep);
/* derive from that a SHM communicator */
MPI_Comm_split_type(shm_comm_prep, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &shm_comm);
MPI_Comm_rank(shm_comm, &shm_ID);
MPI_Comm_size(shm_comm, &shm_procs);
/* do sanity check, making sure groups did not shrink in second comm split */
if (shm_procs != group_size) MPI_Abort(MPI_COMM_WORLD, 666);
/* a non-positive tile size means no tiling of the local transpose */
tiling = (Tile_order > 0) && (Tile_order < order);
bytes = 2 * sizeof(double) * order * order;
/*********************************************************************
** The matrix is broken up into column blocks that are mapped one to a
** rank. Each column block is made up of Num_procs smaller square
** blocks of order block_order.
*********************************************************************/
Num_groups = Num_procs/group_size;
Block_order = order/Num_groups;
group_ID = my_ID/group_size;
colstart = Block_order * group_ID;
Colblock_size = order * Block_order;
Block_size = Block_order * Block_order;
/*********************************************************************
** Create the column block of the test matrix, the column block of the
** transposed matrix, and workspace (workspace only if #procs>1)
*********************************************************************/
/* RMA win info */
MPI_Info_create(&rma_winfo);
/* This key indicates that passive target RMA will not be used.
* It is the one info key that MPICH actually uses for optimization. */
MPI_Info_set(rma_winfo, "no_locks", "true");
/* only the root of each SHM domain specifies window of nonzero size */
size_mul = (shm_ID==0);
int offset = 32;
MPI_Aint size= (Colblock_size+offset)*sizeof(double)*size_mul; int disp_unit;
MPI_Win_allocate_shared(size, sizeof(double), rma_winfo, shm_comm,
(void *) &A_p, &shm_win_A);
MPI_Win_lock_all(MPI_MODE_NOCHECK,shm_win_A);
MPI_Win_shared_query(shm_win_A, MPI_PROC_NULL, &size, &disp_unit, (void *)&A_p);
if (A_p == NULL){
printf(" Error allocating space for original matrix on node %d\n",my_ID);
error = 1;
}
bail_out(error);
A_p += offset;
/* recompute memory size (overwritten by prior query */
size= (Colblock_size+offset)*sizeof(double)*size_mul;
MPI_Win_allocate_shared(size, sizeof(double), rma_winfo, shm_comm,
(void *) &B_p, &shm_win_B);
MPI_Win_lock_all(MPI_MODE_NOCHECK,shm_win_B);
MPI_Win_shared_query(shm_win_B, MPI_PROC_NULL, &size, &disp_unit, (void *)&B_p);
if (B_p == NULL){
printf(" Error allocating space for transposed matrix by group %d\n",group_ID);
error = 1;
}
bail_out(error);
B_p += offset;
if (Num_groups>1) {
size = Block_size*sizeof(double)*size_mul;
MPI_Win_allocate_shared(size, sizeof(double),rma_winfo, shm_comm,
(void *) &Work_in_p, &shm_win_Work_in);
MPI_Win_lock_all(MPI_MODE_NOCHECK,shm_win_Work_in);
MPI_Win_shared_query(shm_win_Work_in, MPI_PROC_NULL, &size, &disp_unit,
(void *)&Work_in_p);
if (Work_in_p == NULL){
printf(" Error allocating space for in block by group %d\n",group_ID);
error = 1;
}
bail_out(error);
/* recompute memory size (overwritten by prior query */
size = Block_size*sizeof(double)*size_mul;
MPI_Win_allocate_shared(size, sizeof(double), rma_winfo,
shm_comm, (void *) &Work_out_p, &shm_win_Work_out);
MPI_Win_lock_all(MPI_MODE_NOCHECK,shm_win_Work_out);
MPI_Win_shared_query(shm_win_Work_out, MPI_PROC_NULL, &size, &disp_unit,
(void *)&Work_out_p);
if (Work_out_p == NULL){
printf(" Error allocating space for out block by group %d\n",group_ID);
error = 1;
}
bail_out(error);
}
/* Fill the original column matrix */
istart = 0;
int chunk_size = Block_order/group_size;
if (tiling) {
for (j=shm_ID*chunk_size;j<(shm_ID+1)*chunk_size;j+=Tile_order) {
for (i=0;i<order; i+=Tile_order)
for (jt=j; jt<MIN((shm_ID+1)*chunk_size,j+Tile_order); jt++)
for (it=i; it<MIN(order,i+Tile_order); it++) {
A(it,jt) = (double) ((double)order*(jt+colstart) + it);
B(it,jt) = -1.0;
}
}
}
else {
for (j=shm_ID*chunk_size;j<(shm_ID+1)*chunk_size;j++)
for (i=0;i<order; i++) {
A(i,j) = (double)((double)order*(j+colstart) + i);
B(i,j) = -1.0;
}
}
/* NEED A STORE FENCE HERE */
MPI_Win_sync(shm_win_A);
MPI_Win_sync(shm_win_B);
MPI_Barrier(shm_comm);
for (iter=0; iter<=iterations; iter++) {
/* start timer after a warmup iteration */
if (iter == 1) {
MPI_Barrier(MPI_COMM_WORLD);
local_trans_time = wtime();
}
/* do the local transpose */
istart = colstart;
if (!tiling) {
for (i=shm_ID*chunk_size; i<(shm_ID+1)*chunk_size; i++) {
for (j=0; j<Block_order; j++)
B(j,i) = A(i,j);
}
}
else {
for (i=shm_ID*chunk_size; i<(shm_ID+1)*chunk_size; i+=Tile_order) {
for (j=0; j<Block_order; j+=Tile_order)
for (it=i; it<MIN(Block_order,i+Tile_order); it++)
for (jt=j; jt<MIN(Block_order,j+Tile_order);jt++) {
B(jt,it) = A(it,jt);
}
}
}
for (phase=1; phase<Num_groups; phase++){
recv_from = ((group_ID + phase )%Num_groups);
send_to = ((group_ID - phase + Num_groups)%Num_groups);
istart = send_to*Block_order;
if (!tiling) {
for (i=shm_ID*chunk_size; i<(shm_ID+1)*chunk_size; i++)
for (j=0; j<Block_order; j++){
Work_out(j,i) = A(i,j);
}
}
else {
for (i=shm_ID*chunk_size; i<(shm_ID+1)*chunk_size; i+=Tile_order)
for (j=0; j<Block_order; j+=Tile_order)
for (it=i; it<MIN(Block_order,i+Tile_order); it++)
for (jt=j; jt<MIN(Block_order,j+Tile_order);jt++) {
Work_out(jt,it) = A(it,jt);
}
}
/* NEED A LOAD/STORE FENCE HERE */
MPI_Win_sync(shm_win_Work_in);
MPI_Win_sync(shm_win_Work_out);
MPI_Barrier(shm_comm);
if (shm_ID==0) {
#ifndef SYNCHRONOUS
/* if we place the Irecv outside this block, it would not be
protected by a local barrier, which creates a race */
MPI_Irecv(Work_in_p, Block_size, MPI_DOUBLE,
recv_from*group_size, phase, MPI_COMM_WORLD, &recv_req);
MPI_Isend(Work_out_p, Block_size, MPI_DOUBLE, send_to*group_size,
phase, MPI_COMM_WORLD, &send_req);
MPI_Wait(&recv_req, &status);
MPI_Wait(&send_req, &status);
#else
MPI_Sendrecv(Work_out_p, Block_size, MPI_DOUBLE, send_to*group_size,
phase, Work_in_p, Block_size, MPI_DOUBLE,
recv_from*group_size, phase, MPI_COMM_WORLD, &status);
#endif
}
/* NEED A LOAD FENCE HERE */
MPI_Win_sync(shm_win_Work_in);
MPI_Win_sync(shm_win_Work_out);
MPI_Barrier(shm_comm);
istart = recv_from*Block_order;
/* scatter received block to transposed matrix; no need to tile */
for (j=shm_ID*chunk_size; j<(shm_ID+1)*chunk_size; j++)
for (i=0; i<Block_order; i++)
B(i,j) = Work_in(i,j);
} /* end of phase loop */
} /* end of iterations */
local_trans_time = wtime() - local_trans_time;
MPI_Reduce(&local_trans_time, &trans_time, 1, MPI_DOUBLE, MPI_MAX, root,
MPI_COMM_WORLD);
abserr = 0.0;
istart = 0;
/* for (j=shm_ID;j<Block_order;j+=group_size) for (i=0;i<order; i++) { */
for (j=shm_ID*chunk_size; j<(shm_ID+1)*chunk_size; j++)
for (i=0;i<order; i++) {
abserr += ABS(B(i,j) - (double)((double)order*i + j+colstart));
}
MPI_Reduce(&abserr, &abserr_tot, 1, MPI_DOUBLE, MPI_SUM, root, MPI_COMM_WORLD);
if (my_ID == root) {
if (abserr_tot < epsilon) {
printf("Solution validates\n");
avgtime = trans_time/(double)iterations;
printf("Rate (MB/s): %lf Avg time (s): %lf\n",1.0E-06*bytes/avgtime, avgtime);
#ifdef VERBOSE
printf("Summed errors: %f \n", abserr_tot);
#endif
}
else {
printf("ERROR: Aggregate squared error %e exceeds threshold %e\n", abserr_tot, epsilon);
error = 1;
}
}
bail_out(error);
MPI_Win_unlock_all(shm_win_A);
MPI_Win_unlock_all(shm_win_B);
MPI_Win_free(&shm_win_A);
MPI_Win_free(&shm_win_B);
if (Num_groups>1) {
MPI_Win_unlock_all(shm_win_Work_in);
MPI_Win_unlock_all(shm_win_Work_out);
MPI_Win_free(&shm_win_Work_in);
MPI_Win_free(&shm_win_Work_out);
}
MPI_Info_free(&rma_winfo);
MPI_Finalize();
exit(EXIT_SUCCESS);
} /* end of main */
int main(int argc, char *argv[]) {
MPI_Win counter, table;
char commands[MAX_COMMANDS][MAX_COMMAND_LEN] = {{0}};
int rank, comm_size, i;
// setenv ("MPICH_ASYNC_PROGRESS", "1", 0);
MPI_Init (&argc, &argv);
MPI_Comm_rank (MPI_COMM_WORLD, &rank);
MPI_Comm_size (MPI_COMM_WORLD, &comm_size);
MPI_Win_create (&commands, MAX_COMMANDS * MAX_COMMAND_LEN, MAX_COMMAND_LEN,
MPI_INFO_NULL, MPI_COMM_WORLD, &table);
MPI_Win_fence (0, table);
// Distribute command lines to tasks, round-robin, start from task 1
i = 0;
if (rank == 0) {
char line[MAX_COMMAND_LEN + 2];
MPI_Win_lock_all (MPI_MODE_NOCHECK, table);
while (fgets (line, MAX_COMMAND_LEN + 2, stdin) != NULL) {
if (i >= MAX_COMMANDS * comm_size) {
fprintf (stderr, "MAX_COMMANDS * comm_size (%d) exceeded.\n", i);
MPI_Abort(MPI_COMM_WORLD, 1);
}
if (strlen (line) > MAX_COMMAND_LEN) {
fprintf (stderr, "MAX_COMMAND_LEN exceeded, line %d: %s\n",
i, line);
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Aint disp = (i / comm_size);
int target_rank = (i + 1) % comm_size;
MPI_Put (line, MAX_COMMAND_LEN, MPI_CHAR, target_rank, disp,
MAX_COMMAND_LEN, MPI_CHAR, table);
MPI_Win_flush_local (target_rank, table);
i++;
}
MPI_Win_unlock_all (table);
}
MPI_Win_fence (0, table);
// Initialize next_command counter/pointer to the top of the command
// line stack.
int next_command;
MPI_Win_create (&next_command, sizeof(int), sizeof(int),
MPI_INFO_NULL, MPI_COMM_WORLD, &counter);
for (i = MAX_COMMANDS - 1; i >= 0; i--) {
if (commands[i][0]) {
next_command = i;
break;
}
}
MPI_Barrier (MPI_COMM_WORLD);
// Execute command lines
//
// Process commands from own rank + steal_increment
const int dec = -1;
int steal_increment = 0;
int current_command;
while (steal_increment < comm_size) {
int current_rank = (rank + steal_increment) % comm_size;
MPI_Win_lock (MPI_LOCK_SHARED, current_rank, 0, counter);
MPI_Fetch_and_op (&dec, ¤t_command, MPI_INT, current_rank,
0, MPI_SUM, counter);
MPI_Win_unlock (current_rank, counter);
if (current_command < 0) {
steal_increment++;
} else {
char command[MAX_COMMAND_LEN] = {0};
MPI_Win_lock (MPI_LOCK_SHARED, current_rank, MPI_MODE_NOCHECK, table);
MPI_Get (&command, MAX_COMMAND_LEN, MPI_CHAR, current_rank,
current_command, MAX_COMMAND_LEN, MPI_CHAR, table);
MPI_Win_unlock (current_rank, table);
system (command);
}
}
MPI_Win_free (&counter);
MPI_Win_free (&table);
MPI_Barrier (MPI_COMM_WORLD);
MPI_Finalize ();
exit (0);
}
int main(int argc, char **argv) {
int i, j, rank, nproc;
int shm_rank, shm_nproc;
MPI_Aint size;
int errors = 0, all_errors = 0;
int *base, *my_base;
int disp_unit;
MPI_Win shm_win;
MPI_Comm shm_comm;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, rank, MPI_INFO_NULL, &shm_comm);
MPI_Comm_rank(shm_comm, &shm_rank);
MPI_Comm_size(shm_comm, &shm_nproc);
/* Allocate ELEM_PER_PROC integers for each process */
MPI_Win_allocate_shared(sizeof(int)*ELEM_PER_PROC, sizeof(int), MPI_INFO_NULL,
shm_comm, &my_base, &shm_win);
/* Locate absolute base */
MPI_Win_shared_query(shm_win, MPI_PROC_NULL, &size, &disp_unit, &base);
/* make sure the query returned the right values */
if (disp_unit != sizeof(int))
errors++;
if (size != ELEM_PER_PROC * sizeof(int))
errors++;
if ((shm_rank == 0) && (base != my_base))
errors++;
if (shm_rank && (base == my_base))
errors++;
if (verbose) printf("%d -- size = %d baseptr = %p my_baseptr = %p\n", shm_rank,
(int) size, (void*) base, (void*) my_base);
MPI_Win_lock_all(MPI_MODE_NOCHECK, shm_win);
/* Write to all my data */
for (i = 0; i < ELEM_PER_PROC; i++) {
my_base[i] = i;
}
MPI_Win_sync(shm_win);
MPI_Barrier(shm_comm);
MPI_Win_sync(shm_win);
/* Read and verify everyone's data */
for (i = 0; i < shm_nproc; i++) {
for (j = 0; j < ELEM_PER_PROC; j++) {
if ( base[i*ELEM_PER_PROC + j] != j ) {
errors++;
printf("%d -- Got %d at rank %d index %d, expected %d\n", shm_rank,
base[i*ELEM_PER_PROC + j], i, j, j);
}
}
}
MPI_Win_unlock_all(shm_win);
MPI_Win_free(&shm_win);
MPI_Comm_free(&shm_comm);
MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
if (rank == 0 && all_errors == 0)
printf(" No Errors\n");
MPI_Finalize();
return 0;
}
/* MAIN */
int
main (int argc, char *argv[])
{
/* to be used for hello world exchanges */
int rank, numtasks, namelen;
char name[MPI_MAX_PROCESSOR_NAME];
/* related to MPI-3 shm*/
MPI_Comm shmcomm; /* shm communicator */
MPI_Win win; /* shm window object */
int *mem; /* shm memory to be allocated on each node */
int i0, i1; int* i2; /* for reading back from shm */
/* current rank exchanges hello world info with partners */
int partners[n_partners];
int *partners_map; /* mapping in shm communicator */
int **partners_ptrs; /* ptrs to shared mem window for each partner*/
int j, partner, alloc_len;
int n_node_partners=0, n_inter_partners=0;
/* non-blocking inter-node */
MPI_Request *reqs, *rq;
int rbuf[n_partners]; /* recv buffer */
int req_num = 2; /* each inter-node echange needs a pair of MPI_Irecv and MPI_Isend */
if (getenv("1DRING_VERBOSE")) verbose = 1; /* Switch on/off printfs thru env */
MPI_Init (&argc, &argv);
MPI_Comm_size (MPI_COMM_WORLD, &numtasks);
MPI_Comm_rank (MPI_COMM_WORLD, &rank);
MPI_Get_processor_name (name, &namelen);
/* if (verbose) printf ("Hello world from COMM_WORLD: rank %d of %d is running on %s\n", rank, numtasks, name); */
/* The 1D ring is defined in partners array. It can be easily expanded to the higher order stencils.
The current rank has 2 neighbours: previous and next, i.e., prev-rank-next */
partners[0] = rank-1; /* prev */
partners[1] = rank+1; /* next */
/* We will use periodic boundary conditions here */
if (rank == 0) partners[0] = numtasks - 1;
if (rank == (numtasks - 1)) partners[1] = 0;
/* MPI-3 SHM collective creates shm communicator */
MPI_Comm_split_type (MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &shmcomm);
/* mapping: global rank -> shmcomm rank is in partners_map */
partners_map = (int*)malloc(n_partners*sizeof(int)); /* allocate partners_map */
translate_ranks(shmcomm, partners, partners_map);
/* number of inter and intra node partners */
get_n_partners (rank, partners, partners_map, &n_node_partners, &n_inter_partners);
if (verbose) print_n_partners (rank, partners, partners_map, n_node_partners, n_inter_partners);
alloc_len = 2*sizeof(int) + namelen+1; /* the size of hello world info: 2 int and string; +1 for '\n' */
if (n_node_partners > 0)
{
/* allocate shared memory windows on each node for intra-node partners */
MPI_Win_allocate_shared (alloc_len, 1, MPI_INFO_NULL, shmcomm, /* inputs to MPI-3 SHM collective */
&mem, &win); /* outputs: mem - initial address of window; win - window object */
/* pointers to mem windows */
partners_ptrs = (int **)malloc(n_partners*sizeof(int*));
get_partners_ptrs (win, partners, partners_map, partners_ptrs );
}
else
{
mem = (int *)malloc(alloc_len);
}
/* allocate MPI Request resources for inter-node comm. */
if(n_inter_partners > 0)
{
reqs = (MPI_Request*)malloc(req_num*n_inter_partners*sizeof(MPI_Request));
rq = reqs;
}
/* start halo exchange */
if (n_node_partners > 0)
{
/* Entering MPI-3 RMA access epoch required for MPI-3 shm */
MPI_Win_lock_all (MPI_MODE_NOCHECK, win);
/* alternatively, MPI_Win_lock_all, MPI_Win_sync and MPI_Barrier can be replaced with
2 MPI_Win_fence calls surrounding update of shared memory. */
/* MPI_Win_fence(0, win); */ /* -- alternative */
}
/* update MPI-3 shared memory (or local memory in case of lack of node partners)
* by writing hello_world info into mem */
mem[0] = rank;
mem[1] = numtasks;
memcpy(mem+2, name, namelen);
if (n_node_partners > 0)
{
/* MPI_Win_fence (0, win); */ /* -- alternative end */
MPI_Win_sync (win); /* memory fence to sync node exchanges */
MPI_Barrier (shmcomm); /* time barrier to make sure all ranks have updated their info */
}
for (j=0; j<n_partners; j++)
{
if(partners_map[j] != MPI_UNDEFINED) /* partner j is on the same node */
{
i0 = partners_ptrs[j][0]; /* load from MPI-3/SHM ops! */
i1 = partners_ptrs[j][1];
i2 = partners_ptrs[j]+2;
if(verbose) printf ("load MPI/SHM values from neighbour => rank %d, numtasks %d on %s\n", i0, i1, i2);
}
else /* inter-node non-blocking MPI-1 */
{
MPI_Irecv (&rbuf[j], 1, MPI_INT, partners[j], 1 , MPI_COMM_WORLD, rq++);
MPI_Isend (&rank, 1, MPI_INT, partners[j], 1 , MPI_COMM_WORLD, rq++);
}
}
/* sync inter-node exchanges and print out receive buffer rbuf*/
if(n_inter_partners > 0)
{
MPI_Waitall (req_num*n_inter_partners, reqs, MPI_STATUS_IGNORE);
if(verbose){
for (j =0; j< n_partners;j++)
if (partners_map[j] == MPI_UNDEFINED) printf("Recieved from my inter-node partner %d\n", rbuf[j]);
}
}
if (n_node_partners > 0)
{
MPI_Win_unlock_all (win); /* close RMA epoch */
/* free resources */
MPI_Win_free (&win);
free (partners_ptrs);
}
if (n_inter_partners) free (reqs);
free (partners_map);
MPI_Finalize ();
return (0);
}
int main(int argc, char ** argv) {
int Num_procs; /* number of ranks */
int Num_procsx,
Num_procsy; /* number of ranks in each coord direction */
int Num_groupsx,
Num_groupsy; /* number of blocks in each coord direction */
int my_group; /* sequence number of shared memory block */
int my_group_IDx,
my_group_IDy; /* coordinates of block within block grid */
int group_size; /* number of ranks in shared memory group */
int group_sizex,
group_sizey; /* number of ranks in block in each coord direction */
int my_ID; /* MPI rank */
int my_global_IDx,
my_global_IDy; /* coordinates of rank in overall rank grid */
int my_local_IDx,
my_local_IDy; /* coordinates of rank within shared memory block */
int right_nbr; /* global rank of right neighboring tile */
int left_nbr; /* global rank of left neighboring tile */
int top_nbr; /* global rank of top neighboring tile */
int bottom_nbr; /* global rank of bottom neighboring tile */
int local_nbr[4]; /* list of synchronizing local neighbors */
int num_local_nbrs; /* number of synchronizing local neighbors */
int dummy;
DTYPE *top_buf_out; /* communication buffer */
DTYPE *top_buf_in; /* " " */
DTYPE *bottom_buf_out; /* " " */
DTYPE *bottom_buf_in; /* " " */
DTYPE *right_buf_out; /* " " */
DTYPE *right_buf_in; /* " " */
DTYPE *left_buf_out; /* " " */
DTYPE *left_buf_in; /* " " */
int root = 0;
long n, width, height;/* linear global and block grid dimension */
int width_rank,
height_rank; /* linear local dimension */
int iter, leftover; /* dummies */
int istart_rank,
iend_rank; /* bounds of grid tile assigned to calling rank */
int jstart_rank,
jend_rank; /* bounds of grid tile assigned to calling rank */
int istart, iend; /* bounds of grid block containing tile */
int jstart, jend; /* bounds of grid block containing tile */
DTYPE norm, /* L1 norm of solution */
local_norm, /* contribution of calling rank to L1 norm */
reference_norm; /* value to be matched by computed norm */
DTYPE f_active_points; /* interior of grid with respect to stencil */
DTYPE flops; /* floating point ops per iteration */
int iterations; /* number of times to run the algorithm */
double local_stencil_time,/* timing parameters */
stencil_time,
avgtime;
int stencil_size; /* number of points in stencil */
DTYPE * RESTRICT in; /* input grid values */
DTYPE * RESTRICT out; /* output grid values */
long total_length_in; /* total required length to store input array */
long total_length_out;/* total required length to store output array */
int error=0; /* error flag */
DTYPE weight[2*RADIUS+1][2*RADIUS+1]; /* weights of points in the stencil */
MPI_Request request[8]; /* requests for sends & receives in 4 coord directions */
MPI_Win shm_win_in; /* shared memory window object for IN array */
MPI_Win shm_win_out; /* shared memory window object for OUT array */
MPI_Comm shm_comm_prep; /* preparatory shared memory communicator */
MPI_Comm shm_comm; /* Shared Memory Communicator */
int shm_procs; /* # of rankes in shared domain */
int shm_ID; /* MPI rank in shared memory domain */
MPI_Aint size_in; /* size of the IN array in shared memory window */
MPI_Aint size_out; /* size of the OUT array in shared memory window */
int size_mul; /* one for shm_comm root, zero for the other ranks */
int disp_unit; /* ignored */
/*******************************************************************************
** Initialize the MPI environment
********************************************************************************/
MPI_Init(&argc,&argv);
MPI_Comm_rank(MPI_COMM_WORLD, &my_ID);
MPI_Comm_size(MPI_COMM_WORLD, &Num_procs);
/*******************************************************************************
** process, test, and broadcast input parameters
********************************************************************************/
if (my_ID == root) {
printf("Parallel Research Kernels version %s\n", PRKVERSION);
printf("MPI+SHM stencil execution on 2D grid\n");
#if !STAR
printf("ERROR: Compact stencil not supported\n");
error = 1;
goto ENDOFTESTS;
#endif
if (argc != 4){
printf("Usage: %s <#ranks per coherence domain><# iterations> <array dimension> \n",
*argv);
error = 1;
goto ENDOFTESTS;
}
group_size = atoi(*++argv);
if (group_size < 1) {
printf("ERROR: # ranks per coherence domain must be >= 1 : %d \n",group_size);
error = 1;
goto ENDOFTESTS;
}
if (Num_procs%group_size) {
printf("ERROR: total # %d ranks not divisible by ranks per coherence domain %d\n",
Num_procs, group_size);
error = 1;
goto ENDOFTESTS;
}
iterations = atoi(*++argv);
if (iterations < 0){
printf("ERROR: iterations must be >= 0 : %d \n",iterations);
error = 1;
goto ENDOFTESTS;
}
n = atol(*++argv);
long nsquare = n * n;
if (nsquare < Num_procs){
printf("ERROR: grid size must be at least # ranks: %ld\n", nsquare);
error = 1;
goto ENDOFTESTS;
}
if (RADIUS < 0) {
printf("ERROR: Stencil radius %d should be non-negative\n", RADIUS);
error = 1;
goto ENDOFTESTS;
}
if (2*RADIUS +1 > n) {
printf("ERROR: Stencil radius %d exceeds grid size %ld\n", RADIUS, n);
error = 1;
goto ENDOFTESTS;
}
ENDOFTESTS:;
}
bail_out(error);
MPI_Bcast(&n, 1, MPI_LONG, root, MPI_COMM_WORLD);
MPI_Bcast(&iterations, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast(&group_size, 1, MPI_INT, root, MPI_COMM_WORLD);
/* determine best way to create a 2D grid of ranks (closest to square, for
best surface/volume ratio); we do this brute force for now. The
decomposition needs to be such that shared memory groups can evenly
tessellate the rank grid
*/
for (Num_procsx=(int) (sqrt(Num_procs+1)); Num_procsx>0; Num_procsx--) {
if (!(Num_procs%Num_procsx)) {
Num_procsy = Num_procs/Num_procsx;
for (group_sizex=(int)(sqrt(group_size+1)); group_sizex>0; group_sizex--) {
if (!(group_size%group_sizex) && !(Num_procsx%group_sizex)) {
group_sizey=group_size/group_sizex;
break;
}
}
if (!(Num_procsy%group_sizey)) break;
}
}
if (my_ID == root) {
printf("Number of ranks = %d\n", Num_procs);
printf("Grid size = %ld\n", n);
printf("Radius of stencil = %d\n", RADIUS);
printf("Tiles in x/y-direction = %d/%d\n", Num_procsx, Num_procsy);
printf("Tiles per shared memory domain = %d\n", group_size);
printf("Tiles in x/y-direction in group = %d/%d\n", group_sizex, group_sizey);
printf("Type of stencil = star\n");
#if LOCAL_BARRIER_SYNCH
printf("Local synchronization = barrier\n");
#else
printf("Local synchronization = point to point\n");
#endif
#if DOUBLE
printf("Data type = double precision\n");
#else
printf("Data type = single precision\n");
#endif
#if LOOPGEN
printf("Script used to expand stencil loop body\n");
#else
printf("Compact representation of stencil loop body\n");
#endif
printf("Number of iterations = %d\n", iterations);
}
/* Setup for Shared memory regions */
/* first divide WORLD in groups of size group_size */
MPI_Comm_split(MPI_COMM_WORLD, my_ID/group_size, my_ID%group_size, &shm_comm_prep);
/* derive from that an SHM communicator */
MPI_Comm_split_type(shm_comm_prep, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &shm_comm);
MPI_Comm_rank(shm_comm, &shm_ID);
MPI_Comm_size(shm_comm, &shm_procs);
/* do sanity check, making sure groups did not shrink in second comm split */
if (shm_procs != group_size) MPI_Abort(MPI_COMM_WORLD, 666);
Num_groupsx = Num_procsx/group_sizex;
Num_groupsy = Num_procsy/group_sizey;
my_group = my_ID/group_size;
my_group_IDx = my_group%Num_groupsx;
my_group_IDy = my_group/Num_groupsx;
my_local_IDx = my_ID%group_sizex;
my_local_IDy = (my_ID%group_size)/group_sizex;
my_global_IDx = my_group_IDx*group_sizex+my_local_IDx;
my_global_IDy = my_group_IDy*group_sizey+my_local_IDy;
/* set all neighboring ranks to -1 (no communication with those ranks) */
left_nbr = right_nbr = top_nbr = bottom_nbr = -1;
/* keep track of local neighbors for local synchronization */
num_local_nbrs = 0;
if (my_local_IDx == group_sizex-1 && my_group_IDx != (Num_groupsx-1)) {
right_nbr = (my_group+1)*group_size+shm_ID-group_sizex+1;
}
if (my_local_IDx != group_sizex-1) {
local_nbr[num_local_nbrs++] = shm_ID + 1;
}
if (my_local_IDx == 0 && my_group_IDx != 0) {
left_nbr = (my_group-1)*group_size+shm_ID+group_sizex-1;
}
if (my_local_IDx != 0) {
local_nbr[num_local_nbrs++] = shm_ID - 1;
}
if (my_local_IDy == group_sizey-1 && my_group_IDy != (Num_groupsy-1)) {
top_nbr = (my_group+Num_groupsx)*group_size + my_local_IDx;
}
if (my_local_IDy != group_sizey-1) {
local_nbr[num_local_nbrs++] = shm_ID + group_sizex;
}
if (my_local_IDy == 0 && my_group_IDy != 0) {
bottom_nbr = (my_group-Num_groupsx)*group_size + group_sizex*(group_sizey-1)+my_local_IDx;
}
if (my_local_IDy != 0) {
local_nbr[num_local_nbrs++] = shm_ID - group_sizex;
}
/* compute amount of space required for input and solution arrays for the block,
and also compute index sets */
width = n/Num_groupsx;
leftover = n%Num_groupsx;
if (my_group_IDx<leftover) {
istart = (width+1) * my_group_IDx;
iend = istart + width;
}
else {
istart = (width+1) * leftover + width * (my_group_IDx-leftover);
iend = istart + width - 1;
}
width = iend - istart + 1;
if (width == 0) {
printf("ERROR: rank %d has no work to do\n", my_ID);
error = 1;
}
bail_out(error);
height = n/Num_groupsy;
leftover = n%Num_groupsy;
if (my_group_IDy<leftover) {
jstart = (height+1) * my_group_IDy;
jend = jstart + height;
}
else {
jstart = (height+1) * leftover + height * (my_group_IDy-leftover);
jend = jstart + height - 1;
}
height = jend - jstart + 1;
if (height == 0) {
printf("ERROR: rank %d has no work to do\n", my_ID);
error = 1;
}
bail_out(error);
if (width < RADIUS || height < RADIUS) {
printf("ERROR: rank %d has work tile smaller then stencil radius; w=%ld,h=%ld\n",
my_ID, width, height);
error = 1;
}
bail_out(error);
total_length_in = (width+2*RADIUS)*(height+2*RADIUS)*sizeof(DTYPE);
total_length_out = width*height*sizeof(DTYPE);
/* only the root of each SHM domain specifies window of nonzero size */
size_mul = (shm_ID==0);
size_in= total_length_in*size_mul;
MPI_Win_allocate_shared(size_in, sizeof(double), MPI_INFO_NULL, shm_comm,
(void *) &in, &shm_win_in);
MPI_Win_lock_all(MPI_MODE_NOCHECK, shm_win_in);
MPI_Win_shared_query(shm_win_in, MPI_PROC_NULL, &size_in, &disp_unit, (void *)&in);
if (in == NULL){
printf("Error allocating space for input array by group %d\n",my_group);
error = 1;
}
bail_out(error);
size_out= total_length_out*size_mul;
MPI_Win_allocate_shared(size_out, sizeof(double), MPI_INFO_NULL, shm_comm,
(void *) &out, &shm_win_out);
MPI_Win_lock_all(MPI_MODE_NOCHECK, shm_win_out);
MPI_Win_shared_query(shm_win_out, MPI_PROC_NULL, &size_out, &disp_unit, (void *)&out);
if (out == NULL){
printf("Error allocating space for output array by group %d\n", my_group);
error = 1;
}
bail_out(error);
/* determine index set assigned to each rank */
width_rank = width/group_sizex;
leftover = width%group_sizex;
if (my_local_IDx<leftover) {
istart_rank = (width_rank+1) * my_local_IDx;
iend_rank = istart_rank + width_rank;
}
else {
istart_rank = (width_rank+1) * leftover + width_rank * (my_local_IDx-leftover);
iend_rank = istart_rank + width_rank - 1;
}
istart_rank += istart;
iend_rank += istart;
width_rank = iend_rank - istart_rank + 1;
height_rank = height/group_sizey;
leftover = height%group_sizey;
if (my_local_IDy<leftover) {
jstart_rank = (height_rank+1) * my_local_IDy;
jend_rank = jstart_rank + height_rank;
}
else {
jstart_rank = (height_rank+1) * leftover + height_rank * (my_local_IDy-leftover);
jend_rank = jstart_rank + height_rank - 1;
}
jstart_rank+=jstart;
jend_rank+=jstart;
height_rank = jend_rank - jstart_rank + 1;
if (height_rank*width_rank==0) {
error = 1;
printf("Rank %d has no work to do\n", my_ID);
}
bail_out(error);
/* allocate communication buffers for halo values */
top_buf_out = (DTYPE *) prk_malloc(4*sizeof(DTYPE)*RADIUS*width_rank);
if (!top_buf_out) {
printf("ERROR: Rank %d could not allocated comm buffers for y-direction\n", my_ID);
error = 1;
}
bail_out(error);
top_buf_in = top_buf_out + RADIUS*width_rank;
bottom_buf_out = top_buf_out + 2*RADIUS*width_rank;
bottom_buf_in = top_buf_out + 3*RADIUS*width_rank;
right_buf_out = (DTYPE *) prk_malloc(4*sizeof(DTYPE)*RADIUS*height_rank);
if (!right_buf_out) {
printf("ERROR: Rank %d could not allocated comm buffers for x-direction\n", my_ID);
error = 1;
}
bail_out(error);
right_buf_in = right_buf_out + RADIUS*height_rank;
left_buf_out = right_buf_out + 2*RADIUS*height_rank;
left_buf_in = right_buf_out + 3*RADIUS*height_rank;
/* fill the stencil weights to reflect a discrete divergence operator */
for (int jj=-RADIUS; jj<=RADIUS; jj++) for (int ii=-RADIUS; ii<=RADIUS; ii++)
WEIGHT(ii,jj) = (DTYPE) 0.0;
stencil_size = 4*RADIUS+1;
for (int ii=1; ii<=RADIUS; ii++) {
WEIGHT(0, ii) = WEIGHT( ii,0) = (DTYPE) (1.0/(2.0*ii*RADIUS));
WEIGHT(0,-ii) = WEIGHT(-ii,0) = -(DTYPE) (1.0/(2.0*ii*RADIUS));
}
norm = (DTYPE) 0.0;
f_active_points = (DTYPE) (n-2*RADIUS)*(DTYPE) (n-2*RADIUS);
/* intialize the input and output arrays */
for (int j=jstart_rank; j<=jend_rank; j++) for (int i=istart_rank; i<=iend_rank; i++) {
IN(i,j) = COEFX*i+COEFY*j;
OUT(i,j) = (DTYPE)0.0;
}
/* LOAD/STORE FENCE */
MPI_Win_sync(shm_win_in);
MPI_Win_sync(shm_win_out);
MPI_Barrier(shm_comm);
for (iter = 0; iter<=iterations; iter++){
/* start timer after a warmup iteration */
if (iter == 1) {
MPI_Barrier(MPI_COMM_WORLD);
local_stencil_time = wtime();
}
/* need to fetch ghost point data from neighbors in y-direction */
if (top_nbr != -1) {
MPI_Irecv(top_buf_in, RADIUS*width_rank, MPI_DTYPE, top_nbr, 101,
MPI_COMM_WORLD, &(request[1]));
for (int kk=0,j=jend_rank-RADIUS+1; j<=jend_rank; j++)
for (int i=istart_rank; i<=iend_rank; i++) {
top_buf_out[kk++]= IN(i,j);
}
MPI_Isend(top_buf_out, RADIUS*width_rank,MPI_DTYPE, top_nbr, 99,
MPI_COMM_WORLD, &(request[0]));
}
if (bottom_nbr != -1) {
MPI_Irecv(bottom_buf_in,RADIUS*width_rank, MPI_DTYPE, bottom_nbr, 99,
MPI_COMM_WORLD, &(request[3]));
for (int kk=0,j=jstart_rank; j<=jstart_rank+RADIUS-1; j++)
for (int i=istart_rank; i<=iend_rank; i++) {
bottom_buf_out[kk++]= IN(i,j);
}
MPI_Isend(bottom_buf_out, RADIUS*width_rank,MPI_DTYPE, bottom_nbr, 101,
MPI_COMM_WORLD, &(request[2]));
}
if (top_nbr != -1) {
MPI_Wait(&(request[0]), MPI_STATUS_IGNORE);
MPI_Wait(&(request[1]), MPI_STATUS_IGNORE);
for (int kk=0,j=jend_rank+1; j<=jend_rank+RADIUS; j++)
for (int i=istart_rank; i<=iend_rank; i++) {
IN(i,j) = top_buf_in[kk++];
}
}
if (bottom_nbr != -1) {
MPI_Wait(&(request[2]), MPI_STATUS_IGNORE);
MPI_Wait(&(request[3]), MPI_STATUS_IGNORE);
for (int kk=0,j=jstart_rank-RADIUS; j<=jstart_rank-1; j++)
for (int i=istart_rank; i<=iend_rank; i++) {
IN(i,j) = bottom_buf_in[kk++];
}
}
/* LOAD/STORE FENCE */
MPI_Win_sync(shm_win_in);
/* need to fetch ghost point data from neighbors in x-direction */
if (right_nbr != -1) {
MPI_Irecv(right_buf_in, RADIUS*height_rank, MPI_DTYPE, right_nbr, 1010,
MPI_COMM_WORLD, &(request[1+4]));
for (int kk=0,j=jstart_rank; j<=jend_rank; j++)
for (int i=iend_rank-RADIUS+1; i<=iend_rank; i++) {
right_buf_out[kk++]= IN(i,j);
}
MPI_Isend(right_buf_out, RADIUS*height_rank, MPI_DTYPE, right_nbr, 990,
MPI_COMM_WORLD, &(request[0+4]));
}
if (left_nbr != -1) {
MPI_Irecv(left_buf_in, RADIUS*height_rank, MPI_DTYPE, left_nbr, 990,
MPI_COMM_WORLD, &(request[3+4]));
for (int kk=0,j=jstart_rank; j<=jend_rank; j++)
for (int i=istart_rank; i<=istart_rank+RADIUS-1; i++) {
left_buf_out[kk++]= IN(i,j);
}
MPI_Isend(left_buf_out, RADIUS*height_rank, MPI_DTYPE, left_nbr, 1010,
MPI_COMM_WORLD, &(request[2+4]));
}
if (right_nbr != -1) {
MPI_Wait(&(request[0+4]), MPI_STATUS_IGNORE);
MPI_Wait(&(request[1+4]), MPI_STATUS_IGNORE);
for (int kk=0,j=jstart_rank; j<=jend_rank; j++)
for (int i=iend_rank+1; i<=iend_rank+RADIUS; i++) {
IN(i,j) = right_buf_in[kk++];
}
}
if (left_nbr != -1) {
MPI_Wait(&(request[2+4]), MPI_STATUS_IGNORE);
MPI_Wait(&(request[3+4]), MPI_STATUS_IGNORE);
for (int kk=0,j=jstart_rank; j<=jend_rank; j++)
for (int i=istart_rank-RADIUS; i<=istart_rank-1; i++) {
IN(i,j) = left_buf_in[kk++];
}
}
/* LOAD/STORE FENCE */
MPI_Win_sync(shm_win_in);
/* Apply the stencil operator */
for (int j=MAX(jstart_rank,RADIUS); j<=MIN(n-RADIUS-1,jend_rank); j++) {
for (int i=MAX(istart_rank,RADIUS); i<=MIN(n-RADIUS-1,iend_rank); i++) {
#if LOOPGEN
#include "loop_body_star.incl"
#else
for (int jj=-RADIUS; jj<=RADIUS; jj++) OUT(i,j) += WEIGHT(0,jj)*IN(i,j+jj);
for (int ii=-RADIUS; ii<0; ii++) OUT(i,j) += WEIGHT(ii,0)*IN(i+ii,j);
for (int ii=1; ii<=RADIUS; ii++) OUT(i,j) += WEIGHT(ii,0)*IN(i+ii,j);
#endif
}
}
/* LOAD/STORE FENCE */
MPI_Win_sync(shm_win_out);
#if LOCAL_BARRIER_SYNCH
MPI_Barrier(shm_comm); // needed to avoid writing IN while other ranks are reading it
#else
for (int i=0; i<num_local_nbrs; i++) {
MPI_Irecv(&dummy, 0, MPI_INT, local_nbr[i], 666, shm_comm, &(request[i]));
MPI_Send(&dummy, 0, MPI_INT, local_nbr[i], 666, shm_comm);
}
MPI_Waitall(num_local_nbrs, request, MPI_STATUSES_IGNORE);
#endif
/* add constant to solution to force refresh of neighbor data, if any */
for (int j=jstart_rank; j<=jend_rank; j++)
for (int i=istart_rank; i<=iend_rank; i++) IN(i,j)+= 1.0;
/* LOAD/STORE FENCE */
MPI_Win_sync(shm_win_in);
#if LOCAL_BARRIER_SYNCH
MPI_Barrier(shm_comm); // needed to avoid reading IN while other ranks are writing it
#else
for (int i=0; i<num_local_nbrs; i++) {
MPI_Irecv(&dummy, 0, MPI_INT, local_nbr[i], 666, shm_comm, &(request[i]));
MPI_Send(&dummy, 0, MPI_INT, local_nbr[i], 666, shm_comm);
}
MPI_Waitall(num_local_nbrs, request, MPI_STATUSES_IGNORE);
#endif
} /* end of iterations */
local_stencil_time = wtime() - local_stencil_time;
MPI_Reduce(&local_stencil_time, &stencil_time, 1, MPI_DOUBLE, MPI_MAX, root,
MPI_COMM_WORLD);
/* compute L1 norm in parallel */
local_norm = (DTYPE) 0.0;
for (int j=MAX(jstart_rank,RADIUS); j<=MIN(n-RADIUS-1,jend_rank); j++) {
for (int i=MAX(istart_rank,RADIUS); i<=MIN(n-RADIUS-1,iend_rank); i++) {
local_norm += (DTYPE)ABS(OUT(i,j));
}
}
MPI_Reduce(&local_norm, &norm, 1, MPI_DTYPE, MPI_SUM, root, MPI_COMM_WORLD);
/*******************************************************************************
** Analyze and output results.
********************************************************************************/
/* verify correctness */
if (my_ID == root) {
norm /= f_active_points;
if (RADIUS > 0) {
reference_norm = (DTYPE) (iterations+1) * (COEFX + COEFY);
}
else {
reference_norm = (DTYPE) 0.0;
}
if (ABS(norm-reference_norm) > EPSILON) {
printf("ERROR: L1 norm = "FSTR", Reference L1 norm = "FSTR"\n",
norm, reference_norm);
error = 1;
}
else {
printf("Solution validates\n");
#if VERBOSE
printf("Reference L1 norm = "FSTR", L1 norm = "FSTR"\n",
reference_norm, norm);
#endif
}
}
bail_out(error);
MPI_Win_unlock_all(shm_win_in);
MPI_Win_unlock_all(shm_win_out);
MPI_Win_free(&shm_win_in);
MPI_Win_free(&shm_win_out);
if (my_ID == root) {
/* flops/stencil: 2 flops (fma) for each point in the stencil,
plus one flop for the update of the input of the array */
flops = (DTYPE) (2*stencil_size+1) * f_active_points;
avgtime = stencil_time/iterations;
printf("Rate (MFlops/s): "FSTR" Avg time (s): %lf\n",
1.0E-06 * flops/avgtime, avgtime);
}
MPI_Finalize();
exit(EXIT_SUCCESS);
}
int main(int argc, char *argv[])
{
int rank, nproc, i;
int errors = 0, all_errors = 0;
int *buf = NULL, *winbuf = NULL;
MPI_Win window;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
if (nproc < 2) {
if (rank == 0)
printf("Error: must be run with two or more processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Alloc_mem(MAX_SIZE * sizeof(int), MPI_INFO_NULL, &buf);
MPI_Alloc_mem(MAX_SIZE * sizeof(int), MPI_INFO_NULL, &winbuf);
MPI_Win_create(winbuf, MAX_SIZE * sizeof(int), sizeof(int), MPI_INFO_NULL,
MPI_COMM_WORLD, &window);
MPI_Win_lock_all(0, window);
/* Test Raccumulate local completion with small data.
* Small data is always copied to header packet as immediate data. */
if (rank == 1) {
for (i = 0; i < ITER; i++) {
MPI_Request acc_req;
int val = -1;
buf[0] = rank * i;
MPI_Raccumulate(&buf[0], 1, MPI_INT, 0, 0, 1, MPI_INT, MPI_MAX, window, &acc_req);
MPI_Wait(&acc_req, MPI_STATUS_IGNORE);
/* reset local buffer to check local completion */
buf[0] = 0;
MPI_Win_flush(0, window);
MPI_Get(&val, 1, MPI_INT, 0, 0, 1, MPI_INT, window);
MPI_Win_flush(0, window);
if (val != rank * i) {
printf("%d - Got %d in small Raccumulate test, expected %d (%d * %d)\n", rank, val,
rank * i, rank, i);
errors++;
}
}
}
MPI_Barrier(MPI_COMM_WORLD);
/* Test Raccumulate local completion with large data .
* Large data is not suitable for 1-copy optimization, and always sent out
* from user buffer. */
if (rank == 1) {
for (i = 0; i < ITER; i++) {
MPI_Request acc_req;
int val0 = -1, val1 = -1, val2 = -1;
int j;
/* initialize data */
for (j = 0; j < MAX_SIZE; j++) {
buf[j] = rank + j + i;
}
MPI_Raccumulate(buf, MAX_SIZE, MPI_INT, 0, 0, MAX_SIZE, MPI_INT, MPI_REPLACE, window,
&acc_req);
MPI_Wait(&acc_req, MPI_STATUS_IGNORE);
/* reset local buffer to check local completion */
buf[0] = 0;
buf[MAX_SIZE - 1] = 0;
buf[MAX_SIZE / 2] = 0;
MPI_Win_flush(0, window);
/* get remote values which are modified in local buffer after wait */
MPI_Get(&val0, 1, MPI_INT, 0, 0, 1, MPI_INT, window);
MPI_Get(&val1, 1, MPI_INT, 0, MAX_SIZE - 1, 1, MPI_INT, window);
MPI_Get(&val2, 1, MPI_INT, 0, MAX_SIZE / 2, 1, MPI_INT, window);
MPI_Win_flush(0, window);
if (val0 != rank + i) {
printf("%d - Got %d in large Raccumulate test, expected %d\n", rank,
val0, rank + i);
errors++;
}
if (val1 != rank + MAX_SIZE - 1 + i) {
printf("%d - Got %d in large Raccumulate test, expected %d\n", rank,
val1, rank + MAX_SIZE - 1 + i);
errors++;
}
if (val2 != rank + MAX_SIZE / 2 + i) {
printf("%d - Got %d in large Raccumulate test, expected %d\n", rank,
val2, rank + MAX_SIZE / 2 + i);
errors++;
}
}
}
MPI_Win_unlock_all(window);
MPI_Barrier(MPI_COMM_WORLD);
MPI_Win_free(&window);
if (buf)
MPI_Free_mem(buf);
if (winbuf)
MPI_Free_mem(winbuf);
MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
if (rank == 0 && all_errors == 0)
printf(" No Errors\n");
MPI_Finalize();
return 0;
}
static int run_test(int nop)
{
int i, x, errs = 0, errs_total = 0;
MPI_Status stat;
int dst;
int winbuf_offset = 0;
double t0, avg_total_time = 0.0, t_total = 0.0;
double sum = 0.0;
if (nprocs <= NPROCS_M) {
ITER = ITER_S;
}
else {
ITER = ITER_L;
}
target_computation_init();
MPI_Win_lock_all(0, win);
t0 = MPI_Wtime();
for (x = 0; x < ITER; x++) {
// send to all the left processes in a ring style
for (dst = (rank + 1) % nprocs; dst != rank; dst = (dst + 1) % nprocs) {
MPI_Accumulate(&locbuf[0], 1, MPI_DOUBLE, dst, rank, 1, MPI_DOUBLE, MPI_SUM, win);
}
MPI_Win_flush_all(win);
target_computation();
for (dst = (rank + 1) % nprocs; dst != rank; dst = (dst + 1) % nprocs) {
for (i = 1; i < nop; i++) {
MPI_Accumulate(&locbuf[i], 1, MPI_DOUBLE, dst, rank, 1, MPI_DOUBLE, MPI_SUM, win);
}
}
MPI_Win_flush_all(win);
debug_printf("[%d]MPI_Win_flush all done\n", x);
}
t_total += MPI_Wtime() - t0;
t_total /= ITER;
MPI_Win_unlock_all(win);
MPI_Barrier(MPI_COMM_WORLD);
target_computation_exit();
#ifdef CHECK
MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
sum = 0.0;
for (i = 0; i < nop; i++) {
sum += locbuf[i];
}
sum *= ITER;
for (i = 0; i < nprocs; i++) {
if (i == rank)
continue;
if (winbuf[i] != sum) {
fprintf(stderr,
"[%d]computation error : winbuf[%d] %.2lf != %.2lf, nop %d\n",
rank, i, winbuf[i], sum, nop);
errs += 1;
}
}
MPI_Win_unlock(rank, win);
#endif
MPI_Reduce(&t_total, &avg_total_time, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
MPI_Allreduce(&errs, &errs_total, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
if (rank == 0) {
avg_total_time /= nprocs;
#ifdef MTCORE
fprintf(stdout,
"mtcore: comp_size %d num_op %d nprocs %d total_time %lf\n",
DGEMM_SIZE, nop, nprocs, avg_total_time);
#else
fprintf(stdout,
"orig: comp_size %d num_op %d nprocs %d total_time %lf\n",
DGEMM_SIZE, nop, nprocs, avg_total_time);
#endif
}
return errs_total;
}
int main( int argc, char *argv[] )
{
int rank, nproc, i;
int errors = 0, all_errors = 0;
int *buf;
MPI_Win window;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
if (nproc < 2) {
if (rank == 0) printf("Error: must be run with two or more processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
/** Create using MPI_Win_create() **/
if (rank == 0) {
MPI_Alloc_mem(4*sizeof(int), MPI_INFO_NULL, &buf);
*buf = nproc-1;
} else
buf = NULL;
MPI_Win_create(buf, 4*sizeof(int)*(rank == 0), 1, MPI_INFO_NULL, MPI_COMM_WORLD, &window);
/* PROC_NULL Communication */
{
MPI_Request pn_req[4];
int val[4], res;
MPI_Win_lock_all(0, window);
MPI_Rget_accumulate(&val[0], 1, MPI_INT, &res, 1, MPI_INT, MPI_PROC_NULL, 0, 1, MPI_INT, MPI_REPLACE, window, &pn_req[0]);
MPI_Rget(&val[1], 1, MPI_INT, MPI_PROC_NULL, 1, 1, MPI_INT, window, &pn_req[1]);
MPI_Rput(&val[2], 1, MPI_INT, MPI_PROC_NULL, 2, 1, MPI_INT, window, &pn_req[2]);
MPI_Raccumulate(&val[3], 1, MPI_INT, MPI_PROC_NULL, 3, 1, MPI_INT, MPI_REPLACE, window, &pn_req[3]);
assert(pn_req[0] != MPI_REQUEST_NULL);
assert(pn_req[1] != MPI_REQUEST_NULL);
assert(pn_req[2] != MPI_REQUEST_NULL);
assert(pn_req[3] != MPI_REQUEST_NULL);
MPI_Win_unlock_all(window);
MPI_Waitall(4, pn_req, MPI_STATUSES_IGNORE);
}
MPI_Barrier(MPI_COMM_WORLD);
MPI_Win_lock(MPI_LOCK_SHARED, 0, 0, window);
/* GET-ACC: Test third-party communication, through rank 0. */
for (i = 0; i < ITER; i++) {
MPI_Request gacc_req;
int val = -1, exp = -1;
/* Processes form a ring. Process 0 starts first, then passes a token
* to the right. Each process, in turn, performs third-party
* communication via process 0's window. */
if (rank > 0) {
MPI_Recv(NULL, 0, MPI_BYTE, rank-1, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
MPI_Rget_accumulate(&rank, 1, MPI_INT, &val, 1, MPI_INT, 0, 0, 1, MPI_INT, MPI_REPLACE, window, &gacc_req);
assert(gacc_req != MPI_REQUEST_NULL);
MPI_Wait(&gacc_req, MPI_STATUS_IGNORE);
MPI_Win_flush(0, window);
exp = (rank + nproc-1) % nproc;
if (val != exp) {
printf("%d - Got %d, expected %d\n", rank, val, exp);
errors++;
}
if (rank < nproc-1) {
MPI_Send(NULL, 0, MPI_BYTE, rank+1, 0, MPI_COMM_WORLD);
}
MPI_Barrier(MPI_COMM_WORLD);
}
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) *buf = nproc-1;
MPI_Win_sync(window);
/* GET+PUT: Test third-party communication, through rank 0. */
for (i = 0; i < ITER; i++) {
MPI_Request req;
int val = -1, exp = -1;
/* Processes form a ring. Process 0 starts first, then passes a token
* to the right. Each process, in turn, performs third-party
* communication via process 0's window. */
if (rank > 0) {
MPI_Recv(NULL, 0, MPI_BYTE, rank-1, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
MPI_Rget(&val, 1, MPI_INT, 0, 0, 1, MPI_INT, window, &req);
assert(req != MPI_REQUEST_NULL);
MPI_Wait(&req, MPI_STATUS_IGNORE);
MPI_Rput(&rank, 1, MPI_INT, 0, 0, 1, MPI_INT, window, &req);
assert(req != MPI_REQUEST_NULL);
MPI_Wait(&req, MPI_STATUS_IGNORE);
MPI_Win_flush(0, window);
exp = (rank + nproc-1) % nproc;
if (val != exp) {
printf("%d - Got %d, expected %d\n", rank, val, exp);
errors++;
}
if (rank < nproc-1) {
MPI_Send(NULL, 0, MPI_BYTE, rank+1, 0, MPI_COMM_WORLD);
}
MPI_Barrier(MPI_COMM_WORLD);
}
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) *buf = nproc-1;
MPI_Win_sync(window);
/* GET+ACC: Test third-party communication, through rank 0. */
for (i = 0; i < ITER; i++) {
MPI_Request req;
int val = -1, exp = -1;
/* Processes form a ring. Process 0 starts first, then passes a token
* to the right. Each process, in turn, performs third-party
* communication via process 0's window. */
if (rank > 0) {
MPI_Recv(NULL, 0, MPI_BYTE, rank-1, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
MPI_Rget(&val, 1, MPI_INT, 0, 0, 1, MPI_INT, window, &req);
assert(req != MPI_REQUEST_NULL);
MPI_Wait(&req, MPI_STATUS_IGNORE);
MPI_Raccumulate(&rank, 1, MPI_INT, 0, 0, 1, MPI_INT, MPI_REPLACE, window, &req);
assert(req != MPI_REQUEST_NULL);
MPI_Wait(&req, MPI_STATUS_IGNORE);
MPI_Win_flush(0, window);
exp = (rank + nproc-1) % nproc;
if (val != exp) {
printf("%d - Got %d, expected %d\n", rank, val, exp);
errors++;
}
if (rank < nproc-1) {
MPI_Send(NULL, 0, MPI_BYTE, rank+1, 0, MPI_COMM_WORLD);
}
MPI_Barrier(MPI_COMM_WORLD);
}
MPI_Win_unlock(0, window);
MPI_Barrier(MPI_COMM_WORLD);
/* Wait inside of an epoch */
{
MPI_Request pn_req[4];
int val[4], res;
const int target = 0;
MPI_Win_lock_all(0, window);
MPI_Rget_accumulate(&val[0], 1, MPI_INT, &res, 1, MPI_INT, target, 0, 1, MPI_INT, MPI_REPLACE, window, &pn_req[0]);
MPI_Rget(&val[1], 1, MPI_INT, target, 1, 1, MPI_INT, window, &pn_req[1]);
MPI_Rput(&val[2], 1, MPI_INT, target, 2, 1, MPI_INT, window, &pn_req[2]);
MPI_Raccumulate(&val[3], 1, MPI_INT, target, 3, 1, MPI_INT, MPI_REPLACE, window, &pn_req[3]);
assert(pn_req[0] != MPI_REQUEST_NULL);
assert(pn_req[1] != MPI_REQUEST_NULL);
assert(pn_req[2] != MPI_REQUEST_NULL);
assert(pn_req[3] != MPI_REQUEST_NULL);
MPI_Waitall(4, pn_req, MPI_STATUSES_IGNORE);
MPI_Win_unlock_all(window);
}
MPI_Barrier(MPI_COMM_WORLD);
/* Wait outside of an epoch */
{
MPI_Request pn_req[4];
int val[4], res;
const int target = 0;
MPI_Win_lock_all(0, window);
MPI_Rget_accumulate(&val[0], 1, MPI_INT, &res, 1, MPI_INT, target, 0, 1, MPI_INT, MPI_REPLACE, window, &pn_req[0]);
MPI_Rget(&val[1], 1, MPI_INT, target, 1, 1, MPI_INT, window, &pn_req[1]);
MPI_Rput(&val[2], 1, MPI_INT, target, 2, 1, MPI_INT, window, &pn_req[2]);
MPI_Raccumulate(&val[3], 1, MPI_INT, target, 3, 1, MPI_INT, MPI_REPLACE, window, &pn_req[3]);
assert(pn_req[0] != MPI_REQUEST_NULL);
assert(pn_req[1] != MPI_REQUEST_NULL);
assert(pn_req[2] != MPI_REQUEST_NULL);
assert(pn_req[3] != MPI_REQUEST_NULL);
MPI_Win_unlock_all(window);
MPI_Waitall(4, pn_req, MPI_STATUSES_IGNORE);
}
/* Wait in a different epoch */
{
MPI_Request pn_req[4];
int val[4], res;
const int target = 0;
MPI_Win_lock_all(0, window);
MPI_Rget_accumulate(&val[0], 1, MPI_INT, &res, 1, MPI_INT, target, 0, 1, MPI_INT, MPI_REPLACE, window, &pn_req[0]);
MPI_Rget(&val[1], 1, MPI_INT, target, 1, 1, MPI_INT, window, &pn_req[1]);
MPI_Rput(&val[2], 1, MPI_INT, target, 2, 1, MPI_INT, window, &pn_req[2]);
MPI_Raccumulate(&val[3], 1, MPI_INT, target, 3, 1, MPI_INT, MPI_REPLACE, window, &pn_req[3]);
assert(pn_req[0] != MPI_REQUEST_NULL);
assert(pn_req[1] != MPI_REQUEST_NULL);
assert(pn_req[2] != MPI_REQUEST_NULL);
assert(pn_req[3] != MPI_REQUEST_NULL);
MPI_Win_unlock_all(window);
MPI_Win_lock_all(0, window);
MPI_Waitall(4, pn_req, MPI_STATUSES_IGNORE);
MPI_Win_unlock_all(window);
}
/* Wait in a fence epoch */
{
MPI_Request pn_req[4];
int val[4], res;
const int target = 0;
MPI_Win_lock_all(0, window);
MPI_Rget_accumulate(&val[0], 1, MPI_INT, &res, 1, MPI_INT, target, 0, 1, MPI_INT, MPI_REPLACE, window, &pn_req[0]);
MPI_Rget(&val[1], 1, MPI_INT, target, 1, 1, MPI_INT, window, &pn_req[1]);
MPI_Rput(&val[2], 1, MPI_INT, target, 2, 1, MPI_INT, window, &pn_req[2]);
MPI_Raccumulate(&val[3], 1, MPI_INT, target, 3, 1, MPI_INT, MPI_REPLACE, window, &pn_req[3]);
assert(pn_req[0] != MPI_REQUEST_NULL);
assert(pn_req[1] != MPI_REQUEST_NULL);
assert(pn_req[2] != MPI_REQUEST_NULL);
assert(pn_req[3] != MPI_REQUEST_NULL);
MPI_Win_unlock_all(window);
MPI_Win_fence(0, window);
MPI_Waitall(4, pn_req, MPI_STATUSES_IGNORE);
MPI_Win_fence(0, window);
}
MPI_Win_free(&window);
if (buf) MPI_Free_mem(buf);
MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
if (rank == 0 && all_errors == 0)
printf(" No Errors\n");
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int rank, size, i, j, k;
int errors = 0;
int origin_shm, origin_am, dest;
int *orig_buf = NULL, *result_buf = NULL, *compare_buf = NULL,
*target_buf = NULL, *check_buf = NULL;
MPI_Win win;
MPI_Status status;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
if (size != 3) {
/* run this test with three processes */
goto exit_test;
}
/* this works when MPIR_PARAM_CH3_ODD_EVEN_CLIQUES is set */
dest = 2;
origin_shm = 0;
origin_am = 1;
if (rank != dest) {
MPI_Alloc_mem(sizeof(int), MPI_INFO_NULL, &orig_buf);
MPI_Alloc_mem(sizeof(int), MPI_INFO_NULL, &result_buf);
MPI_Alloc_mem(sizeof(int), MPI_INFO_NULL, &compare_buf);
}
MPI_Win_allocate(sizeof(int), sizeof(int), MPI_INFO_NULL, MPI_COMM_WORLD, &target_buf, &win);
for (k = 0; k < LOOP_SIZE; k++) {
/* init buffers */
if (rank == origin_shm) {
orig_buf[0] = 1;
compare_buf[0] = 0;
result_buf[0] = 0;
}
else if (rank == origin_am) {
orig_buf[0] = 0;
compare_buf[0] = 1;
result_buf[0] = 0;
}
else {
MPI_Win_lock(MPI_LOCK_SHARED, rank, 0, win);
target_buf[0] = 0;
MPI_Win_unlock(rank, win);
}
MPI_Barrier(MPI_COMM_WORLD);
/* perform FOP */
MPI_Win_lock_all(0, win);
if (rank != dest) {
MPI_Compare_and_swap(orig_buf, compare_buf, result_buf, MPI_INT, dest, 0, win);
MPI_Win_flush(dest, win);
}
MPI_Win_unlock_all(win);
MPI_Barrier(MPI_COMM_WORLD);
/* check results */
if (rank != dest) {
MPI_Gather(result_buf, 1, MPI_INT, check_buf, 1, MPI_INT, dest, MPI_COMM_WORLD);
}
else {
MPI_Alloc_mem(sizeof(int) * 3, MPI_INFO_NULL, &check_buf);
MPI_Gather(target_buf, 1, MPI_INT, check_buf, 1, MPI_INT, dest, MPI_COMM_WORLD);
if (!(check_buf[dest] == 0 && check_buf[origin_shm] == 0 && check_buf[origin_am] == 1)
&& !(check_buf[dest] == 1 && check_buf[origin_shm] == 0 &&
check_buf[origin_am] == 0)) {
printf
("Wrong results: target result = %d, origin_shm result = %d, origin_am result = %d\n",
check_buf[dest], check_buf[origin_shm], check_buf[origin_am]);
printf
("Expected results (1): target result = 1, origin_shm result = 0, origin_am result = 0\n");
printf
("Expected results (2): target result = 0, origin_shm result = 0, origin_am result = 1\n");
errors++;
}
MPI_Free_mem(check_buf);
}
}
MPI_Win_free(&win);
if (rank == origin_am || rank == origin_shm) {
MPI_Free_mem(orig_buf);
MPI_Free_mem(result_buf);
MPI_Free_mem(compare_buf);
}
exit_test:
if (rank == dest && errors == 0)
printf(" No Errors\n");
MPI_Finalize();
return 0;
}
int main(int argc, char ** argv)
{
long Block_order; /* number of columns owned by rank */
long Block_size; /* size of a single block */
long Colblock_size; /* size of column block */
int Tile_order=32; /* default Tile order */
int tiling; /* boolean: true if tiling is used */
int Num_procs; /* number of ranks */
long order; /* order of overall matrix */
int send_to, recv_from; /* ranks with which to communicate */
long bytes; /* combined size of matrices */
int my_ID; /* rank */
int root=0; /* rank of root */
int iterations; /* number of times to do the transpose */
int i, j, it, jt, istart;/* dummies */
int iter; /* index of iteration */
int phase; /* phase inside staged communication */
int colstart; /* starting column for owning rank */
int error; /* error flag */
double RESTRICT *A_p; /* original matrix column block */
double RESTRICT *B_p; /* transposed matrix column block */
double RESTRICT *Work_in_p;/* workspace for transpose function */
double RESTRICT *Work_out_p;/* workspace for transpose function */
double abserr, /* absolute error */
abserr_tot; /* aggregate absolute error */
double epsilon = 1.e-8; /* error tolerance */
double local_trans_time, /* timing parameters */
trans_time,
avgtime;
MPI_Win rma_win = MPI_WIN_NULL;
MPI_Info rma_winfo = MPI_INFO_NULL;
int passive_target = 0; /* use passive target RMA sync */
#if MPI_VERSION >= 3
int flush_local = 1; /* flush local (or remote) after put */
int flush_bundle = 1; /* flush every <bundle> put calls */
#endif
/*********************************************************************
** Initialize the MPI environment
*********************************************************************/
MPI_Init(&argc,&argv);
MPI_Comm_rank(MPI_COMM_WORLD, &my_ID);
MPI_Comm_size(MPI_COMM_WORLD, &Num_procs);
/*********************************************************************
** process, test and broadcast input parameters
*********************************************************************/
error = 0;
if (my_ID == root) {
printf("Parallel Research Kernels version %s\n", PRKVERSION);
printf("MPIRMA matrix transpose: B = A^T\n");
if (argc <= 3){
printf("Usage: %s <# iterations> <matrix order> [Tile size]"
"[sync (0=fence, 1=flush)] [flush local?] [flush bundle]\n",
*argv);
error = 1; goto ENDOFTESTS;
}
iterations = atoi(*++argv);
if(iterations < 1){
printf("ERROR: iterations must be >= 1 : %d \n",iterations);
error = 1; goto ENDOFTESTS;
}
order = atol(*++argv);
if (order < Num_procs) {
printf("ERROR: matrix order %ld should at least # procs %d\n",
order, Num_procs);
error = 1; goto ENDOFTESTS;
}
if (order%Num_procs) {
printf("ERROR: matrix order %ld should be divisible by # procs %d\n",
order, Num_procs);
error = 1; goto ENDOFTESTS;
}
if (argc >= 4) Tile_order = atoi(*++argv);
if (argc >= 5) passive_target = atoi(*++argv);
#if MPI_VERSION >= 3
if (argc >= 6) flush_local = atoi(*++argv);
if (argc >= 7) flush_bundle = atoi(*++argv);
#endif
ENDOFTESTS:;
}
bail_out(error);
if (my_ID == root) {
printf("Number of ranks = %d\n", Num_procs);
printf("Matrix order = %ld\n", order);
printf("Number of iterations = %d\n", iterations);
if ((Tile_order > 0) && (Tile_order < order))
printf("Tile size = %d\n", Tile_order);
else printf("Untiled\n");
if (passive_target) {
#if MPI_VERSION < 3
printf("Synchronization = MPI_Win_(un)lock\n");
#else
printf("Synchronization = MPI_Win_flush%s (bundle=%d)\n", flush_local ? "_local" : "", flush_bundle);
#endif
} else {
printf("Synchronization = MPI_Win_fence\n");
}
}
/* Broadcast input data to all ranks */
MPI_Bcast (&order, 1, MPI_LONG, root, MPI_COMM_WORLD);
MPI_Bcast (&iterations, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast (&Tile_order, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast (&passive_target, 1, MPI_INT, root, MPI_COMM_WORLD);
#if MPI_VERSION >= 3
MPI_Bcast (&flush_local, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast (&flush_bundle, 1, MPI_INT, root, MPI_COMM_WORLD);
#endif
/* a non-positive tile size means no tiling of the local transpose */
tiling = (Tile_order > 0) && (Tile_order < order);
bytes = 2 * sizeof(double) * order * order;
/*********************************************************************
** The matrix is broken up into column blocks that are mapped one to a
** rank. Each column block is made up of Num_procs smaller square
** blocks of order block_order.
*********************************************************************/
Block_order = order/Num_procs;
colstart = Block_order * my_ID;
Colblock_size = order * Block_order;
Block_size = Block_order * Block_order;
/* debug message size effects */
if (my_ID == root) {
printf("Block_size = %ld\n", Block_size);
}
/*********************************************************************
** Create the column block of the test matrix, the row block of the
** transposed matrix, and workspace (workspace only if #procs>1)
*********************************************************************/
A_p = (double *)prk_malloc(Colblock_size*sizeof(double));
if (A_p == NULL){
printf(" Error allocating space for original matrix on node %d\n",my_ID);
error = 1;
}
bail_out(error);
MPI_Info_create (&rma_winfo);
MPI_Info_set (rma_winfo, "no locks", "true");
B_p = (double *)prk_malloc(Colblock_size*sizeof(double));
if (B_p == NULL){
printf(" Error allocating space for transpose matrix on node %d\n",my_ID);
error = 1;
}
bail_out(error);
if (Num_procs>1) {
Work_out_p = (double *) prk_malloc(Block_size*(Num_procs-1)*sizeof(double));
if (Work_out_p == NULL){
printf(" Error allocating space for work_out on node %d\n",my_ID);
error = 1;
}
bail_out(error);
PRK_Win_allocate(Block_size*(Num_procs-1)*sizeof(double), sizeof(double),
rma_winfo, MPI_COMM_WORLD, &Work_in_p, &rma_win);
if (Work_in_p == NULL){
printf(" Error allocating space for work on node %d\n",my_ID);
error = 1;
}
bail_out(error);
}
#if MPI_VERSION >= 3
if (passive_target && Num_procs>1) {
MPI_Win_lock_all(MPI_MODE_NOCHECK,rma_win);
}
#endif
/* Fill the original column matrix */
istart = 0;
for (j=0;j<Block_order;j++) {
for (i=0;i<order; i++) {
A(i,j) = (double) (order*(j+colstart) + i);
B(i,j) = 0.0;
}
}
MPI_Barrier(MPI_COMM_WORLD);
for (iter = 0; iter<=iterations; iter++) {
/* start timer after a warmup iteration */
if (iter == 1) {
MPI_Barrier(MPI_COMM_WORLD);
local_trans_time = wtime();
}
/* do the local transpose */
istart = colstart;
if (!tiling) {
for (i=0; i<Block_order; i++) {
for (j=0; j<Block_order; j++) {
B(j,i) += A(i,j);
A(i,j) += 1.0;
}
}
} else {
for (i=0; i<Block_order; i+=Tile_order) {
for (j=0; j<Block_order; j+=Tile_order) {
for (it=i; it<MIN(Block_order,i+Tile_order); it++) {
for (jt=j; jt<MIN(Block_order,j+Tile_order);jt++) {
B(jt,it) += A(it,jt);
A(it,jt) += 1.0;
}
}
}
}
}
if (!passive_target && Num_procs>1) {
MPI_Win_fence(MPI_MODE_NOSTORE | MPI_MODE_NOPRECEDE, rma_win);
}
for (phase=1; phase<Num_procs; phase++){
send_to = (my_ID - phase + Num_procs)%Num_procs;
istart = send_to*Block_order;
if (!tiling) {
for (i=0; i<Block_order; i++) {
for (j=0; j<Block_order; j++) {
Work_out(phase-1,j,i) = A(i,j);
A(i,j) += 1.0;
}
}
} else {
for (i=0; i<Block_order; i+=Tile_order) {
for (j=0; j<Block_order; j+=Tile_order) {
for (it=i; it<MIN(Block_order,i+Tile_order); it++) {
for (jt=j; jt<MIN(Block_order,j+Tile_order);jt++) {
Work_out(phase-1,jt,it) = A(it,jt);
A(it,jt) += 1.0;
}
}
}
}
}
#if MPI_VERSION < 3
if (passive_target) {
MPI_Win_lock(MPI_LOCK_SHARED, send_to, MPI_MODE_NOCHECK, rma_win);
}
#endif
MPI_Put(Work_out_p+Block_size*(phase-1), Block_size, MPI_DOUBLE, send_to,
Block_size*(phase-1), Block_size, MPI_DOUBLE, rma_win);
if (passive_target) {
#if MPI_VERSION < 3
MPI_Win_unlock(send_to, rma_win);
#else
if (flush_bundle==1) {
if (flush_local==1) {
MPI_Win_flush_local(send_to, rma_win);
} else {
MPI_Win_flush(send_to, rma_win);
}
} else if ( (phase%flush_bundle) == 0) {
/* Too lazy to record all targets, so let MPI do it internally (hopefully) */
if (flush_local==1) {
MPI_Win_flush_local_all(rma_win);
} else {
MPI_Win_flush_all(rma_win);
}
}
#endif
}
} /* end of phase loop for puts */
if (Num_procs>1) {
if (passive_target) {
#if MPI_VERSION >= 3
MPI_Win_flush_all(rma_win);
#endif
MPI_Barrier(MPI_COMM_WORLD);
} else {
MPI_Win_fence(MPI_MODE_NOSTORE, rma_win);
}
}
for (phase=1; phase<Num_procs; phase++) {
recv_from = (my_ID + phase)%Num_procs;
istart = recv_from*Block_order;
/* scatter received block to transposed matrix; no need to tile */
for (j=0; j<Block_order; j++) {
for (i=0; i<Block_order; i++) {
B(i,j) += Work_in(phase-1,i,j);
}
}
} /* end of phase loop for scatters */
/* for the flush case we need to make sure we have consumed Work_in
before overwriting it in the next iteration */
if (Num_procs>1 && passive_target) {
MPI_Barrier(MPI_COMM_WORLD);
}
} /* end of iterations */
local_trans_time = wtime() - local_trans_time;
MPI_Reduce(&local_trans_time, &trans_time, 1, MPI_DOUBLE, MPI_MAX, root,
MPI_COMM_WORLD);
abserr = 0.0;
istart = 0;
double addit = ((double)(iterations+1) * (double) (iterations))/2.0;
for (j=0;j<Block_order;j++) {
for (i=0;i<order; i++) {
abserr += ABS(B(i,j) - ((double)(order*i + j+colstart)*(iterations+1)+addit));
}
}
MPI_Reduce(&abserr, &abserr_tot, 1, MPI_DOUBLE, MPI_SUM, root, MPI_COMM_WORLD);
if (my_ID == root) {
if (abserr_tot < epsilon) {
printf("Solution validates\n");
avgtime = trans_time/(double)iterations;
printf("Rate (MB/s): %lf Avg time (s): %lf\n",1.0E-06*bytes/avgtime, avgtime);
}
else {
printf("ERROR: Aggregate absolute error %lf exceeds threshold %e\n", abserr_tot, epsilon);
error = 1;
}
}
bail_out(error);
if (rma_win!=MPI_WIN_NULL) {
#if MPI_VERSION >=3
if (passive_target) {
MPI_Win_unlock_all(rma_win);
}
#endif
PRK_Win_free(&rma_win);
}
MPI_Finalize();
exit(EXIT_SUCCESS);
} /* end of main */
int main(int argc, char **argv)
{
int i, rank, nproc;
int shm_rank, shm_nproc;
MPI_Aint size;
int errors = 0, all_errors = 0;
int **bases = NULL, *my_base = NULL;
int disp_unit;
MPI_Win shm_win = MPI_WIN_NULL, win = MPI_WIN_NULL;
MPI_Comm shm_comm = MPI_COMM_NULL;
MPI_Group shm_group = MPI_GROUP_NULL, world_group = MPI_GROUP_NULL;
int dst_shm_rank, dst_world_rank;
MPI_Info create_info = MPI_INFO_NULL;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, rank, MPI_INFO_NULL, &shm_comm);
MPI_Comm_rank(shm_comm, &shm_rank);
MPI_Comm_size(shm_comm, &shm_nproc);
/* Platform does not support shared memory, just return. */
if (shm_nproc < 2) {
goto exit;
}
/* Specify the last process in the node as the target process */
dst_shm_rank = shm_nproc - 1;
MPI_Comm_group(shm_comm, &shm_group);
MPI_Comm_group(MPI_COMM_WORLD, &world_group);
MPI_Group_translate_ranks(shm_group, 1, &dst_shm_rank, world_group, &dst_world_rank);
bases = calloc(shm_nproc, sizeof(int *));
/* Allocate shm window among local processes, then create a global window with
* those shm window buffers */
MPI_Win_allocate_shared(sizeof(int) * ELEM_PER_PROC, sizeof(int), MPI_INFO_NULL,
shm_comm, &my_base, &shm_win);
if (verbose)
printf("%d -- allocate shared: my_base = %p, absolute base\n", shm_rank, my_base);
for (i = 0; i < shm_nproc; i++) {
MPI_Win_shared_query(shm_win, i, &size, &disp_unit, &bases[i]);
if (verbose)
printf("%d -- shared query: base[%d]=%p, size %ld, unit %d\n",
shm_rank, i, bases[i], size, disp_unit);
}
#ifdef USE_INFO_ALLOC_SHM
MPI_Info_create(&create_info);
MPI_Info_set(create_info, "alloc_shm", "true");
#else
create_info = MPI_INFO_NULL;
#endif
MPI_Win_create(my_base, sizeof(int) * ELEM_PER_PROC, sizeof(int), create_info, MPI_COMM_WORLD,
&win);
/* Reset data */
for (i = 0; i < ELEM_PER_PROC; i++) {
my_base[i] = 0;
local_buf[i] = i + 1;
}
/* Do RMA through global window, then check value through shared window */
MPI_Win_lock_all(0, win);
MPI_Win_lock_all(0, shm_win);
if (shm_rank == 0) {
MPI_Put(&local_buf[0], 1, MPI_INT, dst_world_rank, 0, 1, MPI_INT, win);
MPI_Put(&local_buf[ELEM_PER_PROC - 1], 1, MPI_INT, dst_world_rank, ELEM_PER_PROC - 1, 1,
MPI_INT, win);
MPI_Win_flush(dst_world_rank, win);
}
MPI_Win_sync(shm_win);
MPI_Barrier(shm_comm);
MPI_Win_sync(shm_win);
if (bases[dst_shm_rank][0] != local_buf[0]) {
errors++;
printf("%d -- Got %d at rank %d index %d, expected %d\n", rank,
bases[dst_shm_rank][0], dst_shm_rank, 0, local_buf[0]);
}
if (bases[dst_shm_rank][ELEM_PER_PROC - 1] != local_buf[ELEM_PER_PROC - 1]) {
errors++;
printf("%d -- Got %d at rank %d index %d, expected %d\n", rank,
bases[dst_shm_rank][ELEM_PER_PROC - 1], dst_shm_rank,
ELEM_PER_PROC - 1, local_buf[ELEM_PER_PROC - 1]);
}
MPI_Win_unlock_all(shm_win);
MPI_Win_unlock_all(win);
MPI_Reduce(&errors, &all_errors, 1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
MPI_Win_free(&win);
MPI_Win_free(&shm_win);
exit:
if (rank == 0 && all_errors == 0)
printf(" No Errors\n");
if (create_info != MPI_INFO_NULL)
MPI_Info_free(&create_info);
if (shm_comm != MPI_COMM_NULL)
MPI_Comm_free(&shm_comm);
if (shm_group != MPI_GROUP_NULL)
MPI_Group_free(&shm_group);
if (world_group != MPI_GROUP_NULL)
MPI_Group_free(&world_group);
MPI_Finalize();
if (bases)
free(bases);
return 0;
}
int main(int argc, char **argv)
{
int r,p;
int n, energy, niters, px, py;
int rx, ry;
int north, south, west, east;
int bx, by, offx, offy;
/* three heat sources */
const int nsources = 3;
int sources[nsources][2];
int locnsources; /* number of sources in my area */
int locsources[nsources][2]; /* sources local to my rank */
double t1, t2;
int iter, i, j;
double heat, rheat;
int final_flag;
/* initialize MPI envrionment */
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &r);
MPI_Comm_size(MPI_COMM_WORLD, &p);
/* create shared memory communicator */
MPI_Comm shmcomm;
MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &shmcomm);
int sr, sp; // rank and size in shmem comm
MPI_Comm_size(shmcomm, &sp);
MPI_Comm_rank(shmcomm, &sr);
// this code works only on comm world!
if(sp != p) MPI_Abort(MPI_COMM_WORLD, 1);
/* argument checking and setting */
setup(r, p, argc, argv,
&n, &energy, &niters, &px, &py, &final_flag);
if (final_flag == 1) {
MPI_Finalize();
exit(0);
}
/* determine my coordinates (x,y) -- r=x*a+y in the 2d processor array */
rx = r % px;
ry = r / px;
/* determine my four neighbors */
north = (ry - 1) * px + rx; if (ry-1 < 0) north = MPI_PROC_NULL;
south = (ry + 1) * px + rx; if (ry+1 >= py) south = MPI_PROC_NULL;
west = ry * px + rx - 1; if (rx-1 < 0) west = MPI_PROC_NULL;
east = ry * px + rx + 1; if (rx+1 >= px) east = MPI_PROC_NULL;
/* decompose the domain */
bx = n / px; /* block size in x */
by = n / py; /* block size in y */
offx = rx * bx; /* offset in x */
offy = ry * by; /* offset in y */
/* printf("%i (%i,%i) - w: %i, e: %i, n: %i, s: %i\n", r, ry,rx,west,east,north,south); */
int size = (bx+2)*(by+2); /* process-local grid (including halos (thus +2)) */
double *mem;
MPI_Win win;
MPI_Win_allocate_shared(2*size*sizeof(double), 1, MPI_INFO_NULL, shmcomm, &mem, &win);
double *tmp;
double *anew=mem; /* each rank's offset */
double *aold=mem+size; /* second half is aold! */
double *northptr, *southptr, *eastptr, *westptr;
double *northptr2, *southptr2, *eastptr2, *westptr2;
MPI_Aint sz;
int dsp_unit;
/* locate the shared memory region for each neighbor */
MPI_Win_shared_query(win, north, &sz, &dsp_unit, &northptr);
MPI_Win_shared_query(win, south, &sz, &dsp_unit, &southptr);
MPI_Win_shared_query(win, east, &sz, &dsp_unit, &eastptr);
MPI_Win_shared_query(win, west, &sz, &dsp_unit, &westptr);
northptr2 = northptr+size;
southptr2 = southptr+size;
eastptr2 = eastptr+size;
westptr2 = westptr+size;
/* initialize three heat sources */
init_sources(bx, by, offx, offy, n,
nsources, sources, &locnsources, locsources);
t1 = MPI_Wtime(); /* take time */
MPI_Win_lock_all(0, win);
for (iter = 0; iter < niters; ++iter) {
/* refresh heat sources */
for (i = 0; i < locnsources; ++i) {
aold[ind(locsources[i][0],locsources[i][1])] += energy; /* heat source */
}
MPI_Win_sync(win);
MPI_Barrier(shmcomm);
/* exchange data with neighbors */
if(north != MPI_PROC_NULL) {
for(i=0; i<bx; ++i) aold[ind(i+1,0)] = northptr2[ind(i+1,by)]; /* pack loop - last valid region */
}
if(south != MPI_PROC_NULL) {
for(i=0; i<bx; ++i) aold[ind(i+1,by+1)] = southptr2[ind(i+1,1)]; /* pack loop */
}
if(east != MPI_PROC_NULL) {
for(i=0; i<by; ++i) aold[ind(bx+1,i+1)] = eastptr2[ind(1,i+1)]; /* pack loop */
}
if(west != MPI_PROC_NULL) {
for(i=0; i<by; ++i) aold[ind(0,i+1)] = westptr2[ind(bx,i+1)]; /* pack loop */
}
/* update grid points */
update_grid(bx, by, aold, anew, &heat);
/* swap working arrays */
tmp = anew; anew = aold; aold = tmp;
/* optional - print image */
if (iter == niters-1) printarr_par(iter, anew, n, px, py, rx, ry, bx, by, offx, offy, shmcomm);
}
MPI_Win_unlock_all(win);
t2 = MPI_Wtime();
/* get final heat in the system */
MPI_Allreduce(&heat, &rheat, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
if (!r) printf("[%i] last heat: %f time: %f\n", r, rheat, t2-t1);
/* free working arrays and communication buffers */
MPI_Win_free(&win);
MPI_Comm_free(&shmcomm);
MPI_Finalize();
}
