int main(int argc, char *argv[])
{
MPI_Info i1, i2;
int errs = 0;
char value[64];
int flag;
MTest_Init(&argc, &argv);
MPI_Info_create(&i1);
MPI_Info_create(&i2);
MPI_Info_set(i1, (char *) "key1", (char *) "value1");
MPI_Info_set(i2, (char *) "key2", (char *) "value2");
MPI_Info_get(i1, (char *) "key2", 64, value, &flag);
if (flag) {
printf("Found key2 in info1\n");
errs++;
}
MPI_Info_get(i1, (char *) "key1", 64, value, &flag);
if (!flag) {
errs++;
printf("Did not find key1 in info1\n");
} else if (strcmp(value, "value1")) {
errs++;
printf("Found wrong value (%s), expected value1\n", value);
}
MPI_Info_free(&i1);
MPI_Info_free(&i2);
MTest_Finalize(errs);
return MTestReturnValue(errs);
}
int main(int argc, char *argv[]) {
int thread_support;
char root_path[MPI_PMEM_MAX_ROOT_PATH];
MPI_Info info;
MPI_Win_pmem win;
char *window_name = "test_window";
char *win_data;
MPI_Aint win_size = 1024;
int error_code;
int result = 0;
MPI_Init_thread_pmem(&argc, &argv, MPI_THREAD_MULTIPLE, &thread_support);
sprintf(root_path, "%s/0", argv[1]);
MPI_Win_pmem_set_root_path(root_path);
// Allocate window.
MPI_Info_create(&info);
MPI_Info_set(info, "pmem_is_pmem", "true");
MPI_Info_set(info, "pmem_name", window_name);
MPI_Info_set(info, "pmem_mode", "checkpoint");
MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
error_code = MPI_Win_allocate_pmem(win_size, 1, info, MPI_COMM_WORLD, &win_data, &win);
MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL);
MPI_Info_free(&info);
if (error_code != MPI_ERR_PMEM_NAME) {
mpi_log_error("Error code is %d, expected %d.", error_code, MPI_ERR_PMEM_NAME);
result = 1;
}
MPI_Finalize_pmem();
return result;
}
int main(int argc, char* argv[])
{
MPI_Init(&argc,&argv);
MPI_Aint bytes = (argc>1) ? atol(argv[1]) : 128*1024*1024;
printf("bytes = %zu\n", bytes);
MPI_Comm comm_shared = MPI_COMM_NULL;
MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0 /* key */, MPI_INFO_NULL, &comm_shared);
MPI_Info info_win = MPI_INFO_NULL;
MPI_Info_create(&info_win);
MPI_Info_set(info_win, "alloc_shared_noncontig", "true");
MPI_Win win_shared = MPI_WIN_NULL;
void * base_ptr = NULL;
int rc = MPI_Win_allocate_shared(bytes, 1 /* disp_unit */, info_win, comm_shared, &base_ptr, &win_shared);
memset(base_ptr,255,bytes);
MPI_Info_free(&info_win);
MPI_Comm_free(&comm_shared);
MPI_Finalize();
return 0;
}
static void
serverWinCreate(void)
{
int ranks[1], modelID;
MPI_Comm commCalc = commInqCommCalc ();
MPI_Group groupCalc;
int nProcsModel = commInqNProcsModel ();
MPI_Info no_locks_info;
xmpi(MPI_Info_create(&no_locks_info));
xmpi(MPI_Info_set(no_locks_info, "no_locks", "true"));
xmpi(MPI_Win_create(MPI_BOTTOM, 0, 1, no_locks_info, commCalc, &getWin));
/* target group */
ranks[0] = nProcsModel;
xmpi ( MPI_Comm_group ( commCalc, &groupCalc ));
xmpi ( MPI_Group_excl ( groupCalc, 1, ranks, &groupModel ));
rxWin = xcalloc((size_t)nProcsModel, sizeof (rxWin[0]));
size_t totalBufferSize = collDefBufferSizes();
rxWin[0].buffer = (unsigned char*) xmalloc(totalBufferSize);
size_t ofs = 0;
for ( modelID = 1; modelID < nProcsModel; modelID++ )
{
ofs += rxWin[modelID - 1].size;
rxWin[modelID].buffer = rxWin[0].buffer + ofs;
}
xmpi(MPI_Info_free(&no_locks_info));
xdebug("%s", "created mpi_win, allocated getBuffer");
}
void *mpp_alloc (size_t len)
{
MPI_Info info;
void *buf = NULL;
#if HAVE_MPI_ALLOC_MEM
if (use_mpi_alloc) {
MPI_Info_create (&info);
#if 0
MPI_Info_set (info, "alignment", "4096");
MPI_Info_set (info, "type", "private");
#endif
MPI_Alloc_mem (len, info, &buf);
MPI_Info_free (&info);
} else
#endif
buf = malloc(len);
if (buf == NULL) {
fprintf (stderr, "Could not allocate %d byte buffer\n", len);
MPI_Abort (MPI_COMM_WORLD, -1);
}
return buf;
}
void mpi_info_free_(MPI_Fint *info, int *ierr )
{
MPI_Info info_c;
info_c = MPI_Info_f2c(*info);
*ierr = MPI_Info_free(&info_c);
*info = MPI_Info_c2f(info_c);
}
int main(int argc, char **argv)
{
int rank;
MPI_Info info_in, info_out;
int errors = 0, all_errors = 0;
MPI_Comm comm;
char __attribute__((unused)) invalid_key[] = "invalid_test_key";
char buf[MPI_MAX_INFO_VAL];
int flag;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Info_create(&info_in);
MPI_Info_set(info_in, invalid_key, (char *) "true");
MPI_Comm_dup(MPI_COMM_WORLD, &comm);
MPI_Comm_set_info(comm, info_in);
MPI_Comm_get_info(comm, &info_out);
MPI_Info_get(info_out, invalid_key, MPI_MAX_INFO_VAL, buf, &flag);
#ifndef USE_STRICT_MPI
/* Check if our invalid key was ignored. Note, this check's MPICH's
* behavior, but this behavior may not be required for a standard
* conforming MPI implementation. */
if (flag) {
printf("%d: %s was not ignored\n", rank, invalid_key);
errors++;
}
#endif
MPI_Info_free(&info_in);
MPI_Info_free(&info_out);
MPI_Comm_free(&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;
}
int main(int argc, char ** argv)
{
MPI_Info info = MPI_INFO_NULL;
MPI_File fh;
MPI_Offset off=0;
MPI_Status status;
int errcode;
int i, rank, errs=0, toterrs, buffer[BUFSIZE], buf2[BUFSIZE];
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Info_create(&info);
MPI_Info_set(info, "romio_cb_write", "enable");
MPI_Info_set(info, "cb_nodes", "1");
for (i=0; i<BUFSIZE; i++) {
buffer[i] = 10000+rank;
}
off = rank*sizeof(buffer);
errcode = MPI_File_open(MPI_COMM_WORLD, argv[1],
MPI_MODE_WRONLY|MPI_MODE_CREATE, info, &fh);
if (errcode != MPI_SUCCESS) handle_error(errcode, "MPI_File_open");
errcode = MPI_File_write_at_all(fh, off, buffer, BUFSIZE,
MPI_INT, &status);
if (errcode != MPI_SUCCESS) handle_error(errcode, "MPI_File_write_at_all");
errcode = MPI_File_close(&fh);
if (errcode != MPI_SUCCESS) handle_error(errcode, "MPI_File_close");
errcode = MPI_File_open(MPI_COMM_WORLD, argv[1],
MPI_MODE_RDONLY, info, &fh);
if (errcode != MPI_SUCCESS) handle_error(errcode, "MPI_File_open");
errcode = MPI_File_read_at_all(fh, off, buf2, BUFSIZE,
MPI_INT, &status);
if (errcode != MPI_SUCCESS) handle_error(errcode, "MPI_File_read_at_all");
errcode = MPI_File_close(&fh);
if (errcode != MPI_SUCCESS) handle_error(errcode, "MPI_File_close");
for (i=0; i<BUFSIZE; i++) {
if (buf2[i] != 10000+rank)
errs++;
}
MPI_Allreduce( &errs, &toterrs, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (rank == 0) {
if( toterrs > 0) {
fprintf( stderr, "Found %d errors\n", toterrs );
}
else {
fprintf( stdout, " No Errors\n" );
}
}
MPI_Info_free(&info);
MPI_Finalize();
return 0;
}
static void dump_mpi_file_info( MPI_File f, const char * prefix = NULL ) {
MPI_Info info;
MPI_CHECK( MPI_File_get_info( f, &info ) );
dump_mpi_info( info, prefix );
MPI_CHECK( MPI_Info_free( &info ) );
}
int
main( int argc, char *argv[] ) {
int nproc = 1, rank = 0;
char *target = NULL;
int c;
MPI_Info info;
int mpi_ret;
int corrupt_blocks = 0;
MPI_Init( &argc, &argv );
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if( (mpi_ret = MPI_Info_create(&info)) != MPI_SUCCESS) {
if(rank == 0) fatal_error( mpi_ret, NULL, "MPI_info_create.\n");
}
prog = strdup( argv[0] );
while( ( c = getopt( argc, argv, "df:h" ) ) != EOF ) {
switch( c ) {
case 'd':
debug = 1;
break;
case 'f':
target = strdup( optarg );
break;
case 'h':
set_hints( &info );
break;
default:
Usage( __LINE__ );
}
}
if ( ! target ) {
Usage( __LINE__ );
}
write_file( target, rank, &info );
read_file( target, rank, &info, &corrupt_blocks );
corrupt_blocks = reduce_corruptions( corrupt_blocks );
if ( rank == 0 ) {
if (corrupt_blocks == 0) {
fprintf(stdout, " No Errors\n");
} else {
fprintf(stdout, "%d/%d blocks corrupt\n",
corrupt_blocks, nproc * NUM_OBJS );
}
}
MPI_Info_free(&info);
MPI_Finalize();
free(prog);
exit( 0 );
}
static void win_info_set(MPI_Win win, const char *key, const char *set_val)
{
MPI_Info info_in = MPI_INFO_NULL;
MPI_Info_create(&info_in);
MPI_Info_set(info_in, key, set_val);
MPI_Win_set_info(win, info_in);
MPI_Info_free(&info_in);
}
void ADIO_End(int *error_code)
{
ADIOI_Flatlist_node *curr, *next;
ADIOI_Datarep *datarep, *datarep_next;
/* FPRINTF(stderr, "reached end\n"); */
/* if a default errhandler was set on MPI_FILE_NULL then we need to ensure
* that our reference to that errhandler is released */
/* Open MPI: The call to PMPI_File_set_errhandler has to be done in romio/src/io_romio_file_open.c
in routine mca_io_romio_file_close()
*/
#if 0
PMPI_File_set_errhandler(MPI_FILE_NULL, MPI_ERRORS_RETURN);
#endif
/* delete the flattened datatype list */
curr = ADIOI_Flatlist;
while (curr) {
if (curr->blocklens) ADIOI_Free(curr->blocklens);
if (curr->indices) ADIOI_Free(curr->indices);
next = curr->next;
ADIOI_Free(curr);
curr = next;
}
ADIOI_Flatlist = NULL;
/* free file and info tables used for Fortran interface */
if (ADIOI_Ftable) ADIOI_Free(ADIOI_Ftable);
#ifndef HAVE_MPI_INFO
if (MPIR_Infotable) ADIOI_Free(MPIR_Infotable);
#endif
/* free the memory allocated for a new data representation, if any */
datarep = ADIOI_Datarep_head;
while (datarep) {
datarep_next = datarep->next;
ADIOI_Free(datarep->name);
ADIOI_Free(datarep);
datarep = datarep_next;
}
if( ADIOI_syshints != MPI_INFO_NULL)
MPI_Info_free(&ADIOI_syshints);
MPI_Op_free(&ADIO_same_amode);
*error_code = MPI_SUCCESS;
}
void IMB_print_info()
/*
Prints MPI_Info selections (MPI-2 only)
*/
{
int nkeys,ikey,vlen,exists;
MPI_Info tmp_info;
char key[MPI_MAX_INFO_KEY], *value;
IMB_user_set_info(&tmp_info);
/* July 2002 fix V2.2.1: handle NULL case */
if( tmp_info!=MPI_INFO_NULL )
{
/* end change */
MPI_Info_get_nkeys(tmp_info, &nkeys);
if( nkeys > 0) fprintf(unit,"# Got %d Info-keys:\n\n",nkeys);
for( ikey=0; ikey<nkeys; ikey++ )
{
MPI_Info_get_nthkey(tmp_info, ikey, key);
MPI_Info_get_valuelen(tmp_info, key, &vlen, &exists);
value = (char*)IMB_v_alloc((vlen+1)* sizeof(char), "Print_Info");
MPI_Info_get(tmp_info, key, vlen, value, &exists);
printf("# %s = \"%s\"\n",key,value);
IMB_v_free ((void**)&value);
}
MPI_Info_free(&tmp_info);
/* July 2002 fix V2.2.1: end if */
}
/* end change */
}
/*----< ncmpio_free_NC() >----------------------------------------------------*/
void
ncmpio_free_NC(NC *ncp)
{
if (ncp == NULL) return;
ncmpio_free_NC_dimarray(&ncp->dims);
ncmpio_free_NC_attrarray(&ncp->attrs);
ncmpio_free_NC_vararray(&ncp->vars);
if (ncp->mpiinfo != MPI_INFO_NULL) MPI_Info_free(&ncp->mpiinfo);
if (ncp->get_list != NULL) NCI_Free(ncp->get_list);
if (ncp->put_list != NULL) NCI_Free(ncp->put_list);
if (ncp->abuf != NULL) NCI_Free(ncp->abuf);
if (ncp->path != NULL) NCI_Free(ncp->path);
NCI_Free(ncp);
}
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 launch_turbine(MPI_Comm comm, char* cmd, int argc, char** argv) {
int status = 0;
char** argvc = (char**)malloc((argc+1)*sizeof(char*));
int i;
for(i=0; i<argc; i++) {
argvc[i] = argv[i];
}
argvc[argc] = NULL;
MPI_Info info;
MPI_Info_create(&info);
MPI_Info_set(info,"launcher","turbine");
MPIX_Comm_launch(cmd, argvc, info, 0, comm, &status);
MPI_Info_free(&info);
free(argvc);
if(comm != MPI_COMM_SELF) {
MPI_Comm_free(&comm);
}
return status;
}
void oshmpi_allock(MPI_Comm comm)
{
MPI_Info lock_info=MPI_INFO_NULL;
MPI_Info_create(&lock_info);
/* We define the sheap size to be symmetric and assume it for the global static data. */
MPI_Info_set(lock_info, "same_size", "true");
MPI_Win_allocate (4 * sizeof (int), sizeof (int), lock_info,
comm, &oshmpi_lock_base, &oshmpi_lock_win);
oshmpi_lock_base[NEXT_DISP] = -1;
oshmpi_lock_base[PREV_DISP] = -1;
oshmpi_lock_base[TAIL_DISP] = -1;
oshmpi_lock_base[LOCK_DISP] = -1;
MPI_Win_lock_all (TAIL, oshmpi_lock_win);
MPI_Info_free(&lock_info);
return;
}
void f_numagg(hid_t *file_id, int *num)
{
#ifndef USE_HDF5
*num = 0;
#else
int ierr;
MPI_File *pFH = NULL;
MPI_Info infoF = MPI_INFO_NULL;
T3PIO_results_t results;
ierr = MPI_Info_create(&infoF);
ierr = H5Fget_vfd_handle(*file_id, H5P_DEFAULT, (void **) &pFH);
ierr = MPI_File_get_info(*pFH, &infoF);
t3pio_extract_key_values(infoF, &results);
*num = results.numIO;
ierr = MPI_Info_free(&infoF);
#endif
}
int main(int argc, char *argv[]) {
int thread_support;
MPI_Info info;
int parsed;
int result = 0;
MPI_Init_thread_pmem(&argc, &argv, MPI_THREAD_MULTIPLE, &thread_support);
MPI_Info_create(&info);
parse_mpi_info_checkpoint_version(MPI_COMM_WORLD, info, &parsed);
MPI_Info_free(&info);
if (parsed != -1) {
mpi_log_error("Checkpoint version is %d, expected -1.", parsed);
result = 1;
}
MPI_Finalize_pmem();
return result;
}
int main(int argc, char *argv[]) {
int thread_support;
char root_path[MPI_PMEM_MAX_ROOT_PATH];
MPI_Info info;
MPI_Win_pmem win, expected_win;
char win_data[1024];
MPI_Aint win_size = 1024;
int result = 0;
MPI_Init_thread_pmem(&argc, &argv, MPI_THREAD_MULTIPLE, &thread_support);
sprintf(root_path, "%s/0", argv[1]);
MPI_Win_pmem_set_root_path(root_path);
MPI_Info_create(&info);
MPI_Info_set(info, "pmem_is_pmem", "true");
MPI_Win_create_pmem(win_data, win_size, 1, info, MPI_COMM_WORLD, &win);
MPI_Info_set(info, "pmem_is_pmem", "false");
MPI_Info_set(info, "pmem_dont_use_transactions", "true");
MPI_Info_set(info, "pmem_keep_all_checkpoints", "true");
MPI_Info_set(info, "pmem_volatile", "true");
MPI_Info_set(info, "pmem_name", "test_window");
MPI_Info_set(info, "pmem_mode", "checkpoint");
MPI_Info_set(info, "pmem_checkpoint_version", "-1");
MPI_Info_set(info, "pmem_append_checkpoints", "true");
MPI_Info_set(info, "pmem_global_checkpoint", "true");
MPI_Win_set_info_pmem(win, info);
MPI_Info_free(&info);
set_default_window_metadata(&expected_win, MPI_COMM_WORLD);
expected_win.is_pmem = true;
result |= check_window_object(win, expected_win, false, true);
result |= check_memory_areas_list_element(win.modifiable_values->memory_areas, win_data, win_size, true, false);
free(expected_win.modifiable_values);
MPI_Win_free_pmem(&win);
MPI_Finalize_pmem();
return result;
}
int launch_envs(MPI_Comm comm, char* cmd,
int argc, char** argv,
int envc, char** envs) {
int status = 0;
char** argvc = (char**)malloc((argc+1)*sizeof(char*));
int i;
for(i=0; i<argc; i++) {
argvc[i] = argv[i];
}
argvc[argc] = NULL;
MPI_Info info = envs2info(envc, envs);
MPIX_Comm_launch(cmd, argvc, info, 0, comm, &status);
if (info != MPI_INFO_NULL) {
MPI_Info_free(&info);
}
free(argvc);
if(comm != MPI_COMM_SELF) {
MPI_Comm_free(&comm);
}
return status;
}
long * allocate_memory (int me, MPI_Win * win)
{
long * msg_buffer;
long * win_base ; /* base */
MPI_Info info;
MPI_Info_create(&info);
MPI_Info_set(info, "same_size", "true");
MPI_Alloc_mem((MAX_MSG_SZ * ITERS_LARGE) * sizeof(long), MPI_INFO_NULL, &msg_buffer);
MPI_Win_allocate((MAX_MSG_SZ * ITERS_LARGE) * sizeof(long), sizeof(long), info, MPI_COMM_WORLD, &win_base, win);
MPI_Win_lock_all (MPI_MODE_NOCHECK, *win);
MPI_Info_free(&info);
if (NULL == msg_buffer && MPI_BOTTOM == win_base) {
fprintf(stderr, "Failed to allocate window (pe: %d)\n", me);
exit(EXIT_FAILURE);
}
return msg_buffer;
}
static int check_win_info_get(MPI_Win win, const char *key, const char *exp_val)
{
int flag = 0;
MPI_Info info_out = MPI_INFO_NULL;
char buf[MPI_MAX_INFO_VAL];
int errors = 0;
MPI_Win_get_info(win, &info_out);
MPI_Info_get(info_out, key, MPI_MAX_INFO_VAL, buf, &flag);
if (!flag || strncmp(buf, exp_val, strlen(exp_val)) != 0) {
if (flag)
printf("%d: %s: expected \"%s\" but got %s\n", rank, key, exp_val, buf);
else
printf("%d: %s not defined\n", rank, key);
errors++;
}
else if (flag && VERBOSE)
printf("%d: %s = %s\n", rank, key, buf);
MPI_Info_free(&info_out);
return errors;
}
int main(int argc, char *argv[]) {
int thread_support;
MPI_Info info;
char parsed[MPI_PMEM_MAX_NAME];
int error_code;
int result = 0;
MPI_Init_thread_pmem(&argc, &argv, MPI_THREAD_MULTIPLE, &thread_support);
MPI_Info_create(&info);
MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
error_code = parse_mpi_info_name(MPI_COMM_WORLD, info, parsed);
MPI_Comm_set_errhandler(MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL);
MPI_Info_free(&info);
if (error_code != MPI_ERR_PMEM_NAME) {
mpi_log_error("Error code is %d, expected %d.", error_code, MPI_ERR_PMEM_NAME);
result = 1;
}
MPI_Finalize_pmem();
return result;
}
void exodus_file_close(exodus_file_t* file)
{
if (file->writing)
{
// Write a QA record.
char* qa_record[1][4];
qa_record[0][0] = string_dup(polymec_executable_name());
qa_record[0][1] = string_dup(polymec_executable_name());
time_t invocation_time = polymec_invocation_time();
struct tm* time_data = localtime(&invocation_time);
char date[20], instant[20];
snprintf(date, 19, "%02d/%02d/%02d", time_data->tm_mon, time_data->tm_mday,
time_data->tm_year % 100);
qa_record[0][2] = string_dup(date);
snprintf(instant, 19, "%02d:%02d:%02d", time_data->tm_hour, time_data->tm_min,
time_data->tm_sec % 60);
qa_record[0][3] = string_dup(instant);
ex_put_qa(file->ex_id, 1, qa_record);
for (int i = 0; i < 4; ++i)
string_free(qa_record[0][i]);
}
// Clean up.
if (file->elem_block_ids != NULL)
polymec_free(file->elem_block_ids);
if (file->face_block_ids != NULL)
polymec_free(file->face_block_ids);
if (file->edge_block_ids != NULL)
polymec_free(file->edge_block_ids);
free_all_variable_names(file);
#if POLYMEC_HAVE_MPI
MPI_Info_free(&file->mpi_info);
#endif
ex_close(file->ex_id);
}
static void
print_hints( int rank, MPI_File *mfh ) {
MPI_Info info;
int nkeys;
int i, dummy_int;
char key[1024];
char value[1024];
MPI_Barrier( MPI_COMM_WORLD );
if ( rank == 0 ) {
MPI_File_get_info( *mfh, &info );
MPI_Info_get_nkeys( info, &nkeys );
printf( "HINTS:\n" );
for( i = 0; i < nkeys; i++ ) {
MPI_Info_get_nthkey( info, i, key );
printf( "%35s -> ", key );
MPI_Info_get( info, key, 1024, value, &dummy_int );
printf( "%s\n", value );
}
MPI_Info_free(&info);
}
MPI_Barrier( MPI_COMM_WORLD );
}
int main(int argc, char *argv[])
{
int error;
int rank, size;
char *argv1[2] = { (char*)"connector", NULL };
char *argv2[2] = { (char*)"acceptor", NULL };
MPI_Comm comm_connector, comm_acceptor, comm_parent, comm;
char port[MPI_MAX_PORT_NAME];
MPI_Status status;
MPI_Info spawn_path = MPI_INFO_NULL;
int verbose = 0;
if (getenv("MPITEST_VERBOSE"))
{
verbose = 1;
}
IF_VERBOSE(("init.\n"));
error = MPI_Init(&argc, &argv);
check_error(error, "MPI_Init");
/* To improve reporting of problems about operations, we
change the error handler to errors return */
MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN );
MPI_Comm_set_errhandler( MPI_COMM_SELF, MPI_ERRORS_RETURN );
IF_VERBOSE(("size.\n"));
error = MPI_Comm_size(MPI_COMM_WORLD, &size);
check_error(error, "MPI_Comm_size");
IF_VERBOSE(("rank.\n"));
error = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
check_error(error, "MPI_Comm_rank");
if (argc == 1)
{
/* Make sure that the current directory is in the path.
Not all implementations may honor or understand this, but
it is highly recommended as it gives users a clean way
to specify the location of the executable without
specifying a particular directory format (e.g., this
should work with both Windows and Unix implementations) */
error = MPI_Info_create( &spawn_path );
check_error( error, "MPI_Info_create" );
error = MPI_Info_set( spawn_path, (char*)"path", (char*)"." );
check_error( error, "MPI_Info_set" );
IF_VERBOSE(("spawn connector.\n"));
error = MPI_Comm_spawn((char*)"spaconacc", argv1, 1, spawn_path, 0,
MPI_COMM_SELF, &comm_connector,
MPI_ERRCODES_IGNORE);
check_error(error, "MPI_Comm_spawn");
IF_VERBOSE(("spawn acceptor.\n"));
error = MPI_Comm_spawn((char*)"spaconacc", argv2, 1, spawn_path, 0,
MPI_COMM_SELF, &comm_acceptor,
MPI_ERRCODES_IGNORE);
check_error(error, "MPI_Comm_spawn");
error = MPI_Info_free( &spawn_path );
check_error( error, "MPI_Info_free" );
MPI_Comm_set_errhandler( comm_connector, MPI_ERRORS_RETURN );
MPI_Comm_set_errhandler( comm_acceptor, MPI_ERRORS_RETURN );
IF_VERBOSE(("recv port.\n"));
error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0,
comm_acceptor, &status);
check_error(error, "MPI_Recv");
IF_VERBOSE(("send port.\n"));
error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0,
comm_connector);
check_error(error, "MPI_Send");
IF_VERBOSE(("barrier acceptor.\n"));
error = MPI_Barrier(comm_acceptor);
check_error(error, "MPI_Barrier");
IF_VERBOSE(("barrier connector.\n"));
error = MPI_Barrier(comm_connector);
check_error(error, "MPI_Barrier");
error = MPI_Comm_free(&comm_acceptor);
check_error(error, "MPI_Comm_free");
error = MPI_Comm_free(&comm_connector);
check_error(error, "MPI_Comm_free");
printf(" No Errors\n");
}
else if ((argc == 2) && (strcmp(argv[1], "acceptor") == 0))
{
IF_VERBOSE(("get_parent.\n"));
error = MPI_Comm_get_parent(&comm_parent);
check_error(error, "MPI_Comm_get_parent");
if (comm_parent == MPI_COMM_NULL)
{
printf("acceptor's parent is NULL.\n");fflush(stdout);
MPI_Abort(MPI_COMM_WORLD, -1);
}
IF_VERBOSE(("open_port.\n"));
error = MPI_Open_port(MPI_INFO_NULL, port);
check_error(error, "MPI_Open_port");
MPI_Comm_set_errhandler( comm_parent, MPI_ERRORS_RETURN );
IF_VERBOSE(("0: opened port: <%s>\n", port));
IF_VERBOSE(("send.\n"));
error = MPI_Send(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0, comm_parent);
check_error(error, "MPI_Send");
IF_VERBOSE(("accept.\n"));
error = MPI_Comm_accept(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm);
check_error(error, "MPI_Comm_accept");
IF_VERBOSE(("close_port.\n"));
error = MPI_Close_port(port);
check_error(error, "MPI_Close_port");
IF_VERBOSE(("disconnect.\n"));
error = MPI_Comm_disconnect(&comm);
check_error(error, "MPI_Comm_disconnect");
IF_VERBOSE(("barrier.\n"));
error = MPI_Barrier(comm_parent);
check_error(error, "MPI_Barrier");
MPI_Comm_free( &comm_parent );
}
else if ((argc == 2) && (strcmp(argv[1], "connector") == 0))
{
IF_VERBOSE(("get_parent.\n"));
error = MPI_Comm_get_parent(&comm_parent);
check_error(error, "MPI_Comm_get_parent");
if (comm_parent == MPI_COMM_NULL)
{
printf("acceptor's parent is NULL.\n");fflush(stdout);
MPI_Abort(MPI_COMM_WORLD, -1);
}
MPI_Comm_set_errhandler( comm_parent, MPI_ERRORS_RETURN );
IF_VERBOSE(("recv.\n"));
error = MPI_Recv(port, MPI_MAX_PORT_NAME, MPI_CHAR, 0, 0,
comm_parent, &status);
check_error(error, "MPI_Recv");
IF_VERBOSE(("1: received port: <%s>\n", port));
IF_VERBOSE(("connect.\n"));
error = MPI_Comm_connect(port, MPI_INFO_NULL, 0, MPI_COMM_SELF, &comm);
check_error(error, "MPI_Comm_connect");
MPI_Comm_set_errhandler( comm, MPI_ERRORS_RETURN );
IF_VERBOSE(("disconnect.\n"));
error = MPI_Comm_disconnect(&comm);
check_error(error, "MPI_Comm_disconnect");
IF_VERBOSE(("barrier.\n"));
error = MPI_Barrier(comm_parent);
check_error(error, "MPI_Barrier");
MPI_Comm_free( &comm_parent );
}
else
{
printf("invalid command line.\n");fflush(stdout);
{
int i;
for (i=0; i<argc; i++)
{
printf("argv[%d] = <%s>\n", i, argv[i]);
}
}
fflush(stdout);
MPI_Abort(MPI_COMM_WORLD, -2);
}
MPI_Finalize();
return 0;
}
/*-------------------------------------------------------------------------
* Function: test_fapl_mpio_dup
*
* Purpose: Test if fapl_mpio property list keeps a duplicate of the
* communicator and INFO objects given when set; and returns
* duplicates of its components when H5Pget_fapl_mpio is called.
*
* Return: Success: None
*
* Failure: Abort
*
* Programmer: Albert Cheng
* January 9, 2003
*
* Modifications:
*-------------------------------------------------------------------------
*/
void
test_fapl_mpio_dup(void)
{
int mpi_size, mpi_rank;
MPI_Comm comm, comm_tmp;
int mpi_size_old, mpi_rank_old;
int mpi_size_tmp, mpi_rank_tmp;
MPI_Info info = MPI_INFO_NULL;
MPI_Info info_tmp = MPI_INFO_NULL;
int mrc; /* MPI return value */
hid_t acc_pl; /* File access properties */
herr_t ret; /* hdf5 return value */
int nkeys, nkeys_tmp;
if (VERBOSE_MED)
printf("Verify fapl_mpio duplicates communicator and INFO objects\n");
/* set up MPI parameters */
MPI_Comm_size(MPI_COMM_WORLD,&mpi_size);
MPI_Comm_rank(MPI_COMM_WORLD,&mpi_rank);
if (VERBOSE_MED)
printf("rank/size of MPI_COMM_WORLD are %d/%d\n", mpi_rank, mpi_size);
/* Create a new communicator that has the same processes as MPI_COMM_WORLD.
* Use MPI_Comm_split because it is simplier than MPI_Comm_create
*/
mrc = MPI_Comm_split(MPI_COMM_WORLD, 0, 0, &comm);
VRFY((mrc==MPI_SUCCESS), "MPI_Comm_split");
MPI_Comm_size(comm,&mpi_size_old);
MPI_Comm_rank(comm,&mpi_rank_old);
if (VERBOSE_MED)
printf("rank/size of comm are %d/%d\n", mpi_rank_old, mpi_size_old);
/* create a new INFO object with some trivial information. */
mrc = MPI_Info_create(&info);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_create");
mrc = MPI_Info_set(info, "hdf_info_name", "XYZ");
VRFY((mrc==MPI_SUCCESS), "MPI_Info_set");
if (MPI_INFO_NULL != info){
mrc=MPI_Info_get_nkeys(info, &nkeys);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_get_nkeys");
}
if (VERBOSE_MED)
h5_dump_info_object(info);
acc_pl = H5Pcreate (H5P_FILE_ACCESS);
VRFY((acc_pl >= 0), "H5P_FILE_ACCESS");
ret = H5Pset_fapl_mpio(acc_pl, comm, info);
VRFY((ret >= 0), "");
/* Case 1:
* Free the created communicator and INFO object.
* Check if the access property list is still valid and can return
* valid communicator and INFO object.
*/
mrc = MPI_Comm_free(&comm);
VRFY((mrc==MPI_SUCCESS), "MPI_Comm_free");
if (MPI_INFO_NULL!=info){
mrc = MPI_Info_free(&info);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_free");
}
ret = H5Pget_fapl_mpio(acc_pl, &comm_tmp, &info_tmp);
VRFY((ret >= 0), "H5Pget_fapl_mpio");
MPI_Comm_size(comm_tmp,&mpi_size_tmp);
MPI_Comm_rank(comm_tmp,&mpi_rank_tmp);
if (VERBOSE_MED)
printf("After H5Pget_fapl_mpio: rank/size of comm are %d/%d\n",
mpi_rank_tmp, mpi_size_tmp);
VRFY((mpi_size_tmp==mpi_size), "MPI_Comm_size");
VRFY((mpi_rank_tmp==mpi_rank), "MPI_Comm_rank");
if (MPI_INFO_NULL != info_tmp){
mrc=MPI_Info_get_nkeys(info_tmp, &nkeys_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_get_nkeys");
VRFY((nkeys_tmp==nkeys), "new and old nkeys equal");
}
if (VERBOSE_MED)
h5_dump_info_object(info_tmp);
/* Case 2:
* Free the retrieved communicator and INFO object.
* Check if the access property list is still valid and can return
* valid communicator and INFO object.
* Also verify the NULL argument option.
*/
mrc = MPI_Comm_free(&comm_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Comm_free");
if (MPI_INFO_NULL!=info_tmp){
mrc = MPI_Info_free(&info_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_free");
}
/* check NULL argument options. */
ret = H5Pget_fapl_mpio(acc_pl, &comm_tmp, NULL);
VRFY((ret >= 0), "H5Pget_fapl_mpio Comm only");
mrc = MPI_Comm_free(&comm_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Comm_free");
ret = H5Pget_fapl_mpio(acc_pl, NULL, &info_tmp);
VRFY((ret >= 0), "H5Pget_fapl_mpio Info only");
if (MPI_INFO_NULL!=info_tmp){
mrc = MPI_Info_free(&info_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_free");
}
ret = H5Pget_fapl_mpio(acc_pl, NULL, NULL);
VRFY((ret >= 0), "H5Pget_fapl_mpio neither");
/* now get both and check validity too. */
/* Donot free the returned objects which are used in the next case. */
ret = H5Pget_fapl_mpio(acc_pl, &comm_tmp, &info_tmp);
VRFY((ret >= 0), "H5Pget_fapl_mpio");
MPI_Comm_size(comm_tmp,&mpi_size_tmp);
MPI_Comm_rank(comm_tmp,&mpi_rank_tmp);
if (VERBOSE_MED)
printf("After second H5Pget_fapl_mpio: rank/size of comm are %d/%d\n",
mpi_rank_tmp, mpi_size_tmp);
VRFY((mpi_size_tmp==mpi_size), "MPI_Comm_size");
VRFY((mpi_rank_tmp==mpi_rank), "MPI_Comm_rank");
if (MPI_INFO_NULL != info_tmp){
mrc=MPI_Info_get_nkeys(info_tmp, &nkeys_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_get_nkeys");
VRFY((nkeys_tmp==nkeys), "new and old nkeys equal");
}
if (VERBOSE_MED)
h5_dump_info_object(info_tmp);
/* Case 3:
* Close the property list and verify the retrieved communicator and INFO
* object are still valid.
*/
H5Pclose(acc_pl);
MPI_Comm_size(comm_tmp,&mpi_size_tmp);
MPI_Comm_rank(comm_tmp,&mpi_rank_tmp);
if (VERBOSE_MED)
printf("After Property list closed: rank/size of comm are %d/%d\n",
mpi_rank_tmp, mpi_size_tmp);
if (MPI_INFO_NULL != info_tmp){
mrc=MPI_Info_get_nkeys(info_tmp, &nkeys_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_get_nkeys");
}
if (VERBOSE_MED)
h5_dump_info_object(info_tmp);
/* clean up */
mrc = MPI_Comm_free(&comm_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Comm_free");
if (MPI_INFO_NULL!=info_tmp){
mrc = MPI_Info_free(&info_tmp);
VRFY((mrc==MPI_SUCCESS), "MPI_Info_free");
}
}
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_Info info_in, info_out;
int errors = 0, all_errors = 0;
MPI_Win win;
void *base;
char invalid_key[] = "invalid_test_key";
char buf[MPI_MAX_INFO_VAL];
int flag;
MPI_Comm shm_comm = MPI_COMM_NULL;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &nproc);
/* Test#1: setting a valid key at window-create time */
MPI_Info_create(&info_in);
MPI_Info_set(info_in, "no_locks", "true");
MPI_Win_allocate(sizeof(int), sizeof(int), info_in, MPI_COMM_WORLD, &base, &win);
errors += check_win_info_get(win, "no_locks", "true");
MPI_Info_free(&info_in);
/* We create a new window with no info argument for the next text to ensure that we have the
* default settings */
MPI_Win_free(&win);
MPI_Win_allocate(sizeof(int), sizeof(int), MPI_INFO_NULL, MPI_COMM_WORLD, &base, &win);
/* Test#2: setting and getting invalid key */
win_info_set(win, invalid_key, "true");
MPI_Win_get_info(win, &info_out);
MPI_Info_get(info_out, invalid_key, MPI_MAX_INFO_VAL, buf, &flag);
#ifndef USE_STRICT_MPI
/* Check if our invalid key was ignored. Note, this check's MPICH's
* behavior, but this behavior may not be required for a standard
* conforming MPI implementation. */
if (flag) {
printf("%d: %s was not ignored\n", rank, invalid_key);
errors++;
}
#endif
MPI_Info_free(&info_out);
/* Test#3: setting info key "no_lock" (no default value) */
win_info_set(win, "no_locks", "false");
errors += check_win_info_get(win, "no_locks", "false");
win_info_set(win, "no_locks", "true");
errors += check_win_info_get(win, "no_locks", "true");
/* Test#4: getting/setting "accumulate_ordering" */
/* #4.1: is the default "rar,raw,war,waw" as stated in the standard? */
errors += check_win_info_get(win, "accumulate_ordering", "rar,raw,war,waw");
/* #4.2: setting "accumulate_ordering" to "none" */
win_info_set(win, "accumulate_ordering", "none");
errors += check_win_info_get(win, "accumulate_ordering", "none");
/* #4.3: setting "accumulate_ordering" to "rar,waw" */
win_info_set(win, "accumulate_ordering", "rar,waw");
errors += check_win_info_get(win, "accumulate_ordering", "rar,waw");
/* Test#5: getting/setting "accumulate_ops" */
/* #5.1: is the default "same_op_no_op" as stated in the standard? */
errors += check_win_info_get(win, "accumulate_ops", "same_op_no_op");
/* #5.2: setting "accumulate_ops" to "same_op" */
win_info_set(win, "accumulate_ops", "same_op");
errors += check_win_info_get(win, "accumulate_ops", "same_op");
/* Test#6: setting "same_size" (no default value) */
win_info_set(win, "same_size", "false");
errors += check_win_info_get(win, "same_size", "false");
win_info_set(win, "same_size", "true");
errors += check_win_info_get(win, "same_size", "true");
/* Test#7: setting "same_disp_unit" (no default value) */
win_info_set(win, "same_disp_unit", "false");
errors += check_win_info_get(win, "same_disp_unit", "false");
win_info_set(win, "same_disp_unit", "true");
errors += check_win_info_get(win, "same_disp_unit", "true");
/* TODO: check alloc_shm as implementation-specific test */
/* Test#8: setting "alloc_shared_noncontig" (no default value) in shared window. */
MPI_Win_free(&win);
/* #8.1: setting at window allocation */
MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, rank, MPI_INFO_NULL, &shm_comm);
MPI_Info_create(&info_in);
MPI_Info_set(info_in, "alloc_shared_noncontig", "true");
MPI_Win_allocate_shared(sizeof(int), sizeof(int), info_in, shm_comm, &base, &win);
errors += check_win_info_get(win, "alloc_shared_noncontig", "true");
MPI_Info_free(&info_in);
/* #8.2: setting info */
win_info_set(win, "alloc_shared_noncontig", "false");
errors += check_win_info_get(win, "alloc_shared_noncontig", "false");
MPI_Comm_free(&shm_comm);
MPI_Win_free(&win);
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;
}