int main(int argc, char *argv[])
{
int errs = 0;
MPI_Datatype outtype, oldtypes[2];
MPI_Aint offsets[2];
int blklens[2];
MPI_Comm comm;
int size, rank, src, dest, tag;
MTest_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
if (size < 2) {
errs++;
printf("This test requires at least 2 processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
src = 0;
dest = 1;
if (rank == src) {
int buf[128], position, cnt;
MTEST_VG_MEM_INIT(buf, 128 * sizeof(buf[0]));
/* sender */
/* Create a datatype and send it (multiple of sizeof(int)) */
/* Create a send struct type */
oldtypes[0] = MPI_INT;
oldtypes[1] = MPI_CHAR;
blklens[0] = 1;
blklens[1] = 4 * sizeof(int);
offsets[0] = 0;
offsets[1] = sizeof(int);
MPI_Type_struct(2, blklens, offsets, oldtypes, &outtype);
MPI_Type_commit(&outtype);
buf[0] = 4 * sizeof(int);
/* printf("About to send to %d\n", dest); */
MPI_Send(buf, 1, outtype, dest, 0, comm);
MPI_Type_free(&outtype);
/* Create a datatype and send it (not a multiple of sizeof(int)) */
/* Create a send struct type */
oldtypes[0] = MPI_INT;
oldtypes[1] = MPI_CHAR;
blklens[0] = 1;
blklens[1] = 4 * sizeof(int) + 1;
offsets[0] = 0;
offsets[1] = sizeof(int);
MPI_Type_struct(2, blklens, offsets, oldtypes, &outtype);
MPI_Type_commit(&outtype);
buf[0] = 4 * sizeof(int) + 1;
MPI_Send(buf, 1, outtype, dest, 1, comm);
MPI_Type_free(&outtype);
/* Pack data and send as packed */
position = 0;
cnt = 7;
MPI_Pack(&cnt, 1, MPI_INT, buf, 128 * sizeof(int), &position, comm);
MPI_Pack((void *) "message", 7, MPI_CHAR, buf, 128 * sizeof(int), &position, comm);
MPI_Send(buf, position, MPI_PACKED, dest, 2, comm);
}
else if (rank == dest) {
MPI_Status status;
int buf[128], i, elms, count;
/* Receiver */
/* Create a receive struct type */
oldtypes[0] = MPI_INT;
oldtypes[1] = MPI_CHAR;
blklens[0] = 1;
blklens[1] = 256;
offsets[0] = 0;
offsets[1] = sizeof(int);
MPI_Type_struct(2, blklens, offsets, oldtypes, &outtype);
MPI_Type_commit(&outtype);
for (i = 0; i < 3; i++) {
tag = i;
/* printf("about to receive tag %d from %d\n", i, src); */
MPI_Recv(buf, 1, outtype, src, tag, comm, &status);
MPI_Get_elements(&status, outtype, &elms);
if (elms != buf[0] + 1) {
errs++;
printf("For test %d, Get elements gave %d but should be %d\n", i, elms, buf[0] + 1);
}
MPI_Get_count(&status, outtype, &count);
if (count != MPI_UNDEFINED) {
errs++;
printf("For partial send, Get_count did not return MPI_UNDEFINED\n");
}
}
MPI_Type_free(&outtype);
}
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int rank, nprocs, i, *counter_mem, *get_array, *get_idx, *acc_idx,
mask, nlevels, level, idx, tmp_rank, pof2;
MPI_Datatype get_type, acc_type;
MPI_Win win;
int errs = 0, *results, *counter_vals;
MTest_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD,&nprocs);
MPI_Comm_rank(MPI_COMM_WORLD,&rank);
if (rank == 0) {
/* allocate counter memory and initialize to 0 */
/* find the next power-of-two >= nprocs */
pof2 = 1;
while (pof2 < nprocs) pof2 *= 2;
counter_mem = (int *) calloc(pof2*2, sizeof(int));
MPI_Win_create(counter_mem, pof2*2*sizeof(int), sizeof(int),
MPI_INFO_NULL, MPI_COMM_WORLD, &win);
MPI_Win_free(&win);
free(counter_mem);
/* gather the results from other processes, sort them, and check
whether they represent a counter being incremented by 1 */
results = (int *) malloc(NTIMES*nprocs*sizeof(int));
for (i=0; i<NTIMES*nprocs; i++)
results[i] = -1;
MPI_Gather(MPI_IN_PLACE, 0, MPI_DATATYPE_NULL, results, NTIMES, MPI_INT,
0, MPI_COMM_WORLD);
qsort(results+NTIMES, NTIMES*(nprocs-1), sizeof(int), compar);
for (i=NTIMES+1; i<(NTIMES*nprocs); i++)
if (results[i] != results[i-1] + 1)
errs++;
free(results);
}
else {
/* Get the largest power of two smaller than nprocs */
mask = 1;
nlevels = 0;
while (mask < nprocs) {
mask <<= 1;
nlevels++;
}
mask >>= 1;
get_array = (int *) malloc(nlevels * sizeof(int));
get_idx = (int *) malloc(nlevels * sizeof(int));
acc_idx = (int *) malloc(nlevels * sizeof(int));
level = 0;
idx = 0;
tmp_rank = rank;
while (mask >= 1) {
if (tmp_rank < mask) {
/* go to left for acc_idx, go to right for
get_idx. set idx=acc_idx for next iteration */
acc_idx[level] = idx + 1;
get_idx[level] = idx + mask*2;
idx = idx + 1;
}
else {
/* go to right for acc_idx, go to left for
get_idx. set idx=acc_idx for next iteration */
acc_idx[level] = idx + mask*2;
get_idx[level] = idx + 1;
idx = idx + mask*2;
}
level++;
tmp_rank = tmp_rank % mask;
mask >>= 1;
}
/* for (i=0; i<nlevels; i++)
printf("Rank %d, acc_idx[%d]=%d, get_idx[%d]=%d\n", rank,
i, acc_idx[i], i, get_idx[i]);
*/
MPI_Type_create_indexed_block(nlevels, 1, get_idx, MPI_INT, &get_type);
MPI_Type_create_indexed_block(nlevels, 1, acc_idx, MPI_INT, &acc_type);
MPI_Type_commit(&get_type);
MPI_Type_commit(&acc_type);
/* allocate array to store the values obtained from the
fetch-and-add counter */
counter_vals = (int *) malloc(NTIMES * sizeof(int));
MPI_Win_create(NULL, 0, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &win);
for (i=0; i<NTIMES; i++) {
Get_nextval_tree(win, get_array, get_type, acc_type,
nlevels, counter_vals+i);
/* printf("Rank %d, counter %d\n", rank, value); */
}
MPI_Win_free(&win);
free(get_array);
free(get_idx);
free(acc_idx);
MPI_Type_free(&get_type);
MPI_Type_free(&acc_type);
/* gather the results to the root */
MPI_Gather(counter_vals, NTIMES, MPI_INT, NULL, 0, MPI_DATATYPE_NULL,
0, MPI_COMM_WORLD);
free(counter_vals);
}
MTest_Finalize(errs);
MPI_Finalize();
return MTestReturnValue( errs );
}
int main(int argc, char* argv[]) {
assert(argc == 8);
MPI_Init(NULL, NULL);
MPI_Datatype mpi_spike = create_spike_type();
int rank, size;
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
int ngroups = atoi(argv[1]);
int simtime = atoi(argv[2]);
int ncells = atoi(argv[3]);
int fanin = atoi(argv[4]);
int nSpikes = atoi(argv[5]);
int mindelay = atoi(argv[6]);
bool algebra = atoi(argv[7]);
struct timeval start, end;
int cellsper = ncells / size;
//create environment
environment::event_generator generator(ngroups);
double mean = static_cast<double>(simtime) / static_cast<double>(nSpikes);
double lambda = 1.0 / static_cast<double>(mean * size);
environment::continousdistribution neuro_dist(size, rank, ncells);
environment::generate_events_kai(generator.begin(),
simtime, ngroups, rank, size, lambda, &neuro_dist);
environment::presyn_maker presyns(fanin);
presyns(rank, &neuro_dist);
spike::spike_interface s_interface(size);
//run simulation
MPI_Comm neighborhood = create_dist_graph(presyns, cellsper);
queueing::pool pl(algebra, ngroups, mindelay, rank, s_interface);
gettimeofday(&start, NULL);
while(pl.get_time() <= simtime){
pl.fixed_step(generator, presyns);
distributed_spike(s_interface, mpi_spike, neighborhood);
pl.filter(presyns);
}
gettimeofday(&end, NULL);
long long diff_ms = (1000 * (end.tv_sec - start.tv_sec))
+ ((end.tv_usec - start.tv_usec) / 1000);
if(rank == 0){
std::cout<<"run time: "<<diff_ms<<" ms"<<std::endl;
}
pl.accumulate_stats();
accumulate_stats(s_interface);
MPI_Comm_free(&neighborhood);
MPI_Type_free(&mpi_spike);
MPI_Finalize();
return 0;
}
int TestVecPackDouble(int n, int stride,
double *avgTimeUser, double *avgTimeMPI, double *dest, const double *src)
{
double *restrict d_dest;
const double *restrict d_src;
register int i, j;
int rep, position;
double t1, t2, t[NTRIALS];
MPI_Datatype vectype;
/* User code */
if (verbose)
printf("TestVecPackDouble (USER): ");
for (j = 0; j < NTRIALS; j++) {
t1 = MPI_Wtime();
for (rep = 0; rep < N_REPS; rep++) {
i = n;
d_dest = dest;
d_src = src;
while (i--) {
*d_dest++ = *d_src;
d_src += stride;
}
}
t2 = MPI_Wtime() - t1;
t[j] = t2;
if (verbose)
printf("%.3f ", t[j]);
}
if (verbose)
printf("[%.3f]\n", noise(t, NTRIALS));
/* If there is too much noise, discard the test */
if (noise(t, NTRIALS) > VARIANCE_THRESHOLD) {
*avgTimeUser = 0;
*avgTimeMPI = 0;
if (verbose)
printf("Too much noise; discarding measurement\n");
return 0;
}
*avgTimeUser = mean(t, NTRIALS) / N_REPS;
/* MPI Vector code */
MPI_Type_vector(n, 1, stride, MPI_DOUBLE, &vectype);
MPI_Type_commit(&vectype);
if (verbose)
printf("TestVecPackDouble (MPI): ");
for (j = 0; j < NTRIALS; j++) {
t1 = MPI_Wtime();
for (rep = 0; rep < N_REPS; rep++) {
position = 0;
MPI_Pack((void *) src, 1, vectype, dest, n * sizeof(double), &position, MPI_COMM_SELF);
}
t2 = MPI_Wtime() - t1;
t[j] = t2;
if (verbose)
printf("%.3f ", t[j]);
}
if (verbose)
printf("[%.3f]\n", noise(t, NTRIALS));
/* If there is too much noise, discard the test */
if (noise(t, NTRIALS) > VARIANCE_THRESHOLD) {
*avgTimeUser = 0;
*avgTimeMPI = 0;
if (verbose)
printf("Too much noise; discarding measurement\n");
}
else {
*avgTimeMPI = mean(t, NTRIALS) / N_REPS;
}
MPI_Type_free(&vectype);
return 0;
}
int main(int argc, char * argv[])
{
int provided;
MPI_ASSERT(MPI_Init_thread(&argc, &argv, MPI_THREAD_SINGLE, &provided));
int rank, size;
MPI_ASSERT(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
MPI_ASSERT(MPI_Comm_size(MPI_COMM_WORLD, &size));
int logn = (argc>1) ? atoi(argv[1]) : 32;
size_t count = (size_t)1<<logn; /* explicit cast required */
printf("count = %zu \n", count );
MPI_Datatype bigtype;
MPI_ASSERT(MPIX_Type_contiguous_x( (MPI_Count)count, MPI_CHAR, &bigtype));
MPI_ASSERT(MPI_Type_commit(&bigtype));
char * rbuf = NULL;
char * sbuf = NULL;
#ifdef USE_MPI_ALLOC_MEM
MPI_ASSERT(MPI_Alloc_mem( (MPI_Aint)count * sizeof(char), MPI_INFO_NULL, &rbuf));
MPI_ASSERT(MPI_Alloc_mem( (MPI_Aint)count * sizeof(char), MPI_INFO_NULL, &sbuf));
#else
rbuf = malloc( count * sizeof(char));
assert(rbuf!=NULL);
sbuf = malloc( count * sizeof(char));
assert(sbuf!=NULL);
#endif
for (size_t i=0; i<count; i++)
rbuf[i] = 'a';
for (size_t i=0; i<count; i++)
sbuf[i] = 'z';
MPI_Request requests[2];
MPI_Status statuses[2];
if (rank==(size-1)) {
MPI_ASSERT(MPI_Irecv(rbuf, 1, bigtype, 0, 0, MPI_COMM_WORLD, &(requests[1]) ));
}
if (rank==0) {
MPI_ASSERT(MPI_Isend(sbuf, 1, bigtype, size-1, 0, MPI_COMM_WORLD, &(requests[0]) ));
}
MPI_Count ocount[2];
if (size==1) {
MPI_ASSERT(MPI_Waitall(2, requests, statuses));
MPI_ASSERT(MPI_Get_elements_x( &(statuses[1]), MPI_CHAR, &(ocount[1])));
}
else {
if (rank==(size-1)) {
MPI_ASSERT(MPI_Wait( &(requests[1]), &(statuses[1]) ));
MPI_ASSERT(MPI_Get_elements_x( &(statuses[1]), MPI_CHAR, &(ocount[1]) ));
} else if (rank==0) {
MPI_ASSERT(MPI_Wait( &(requests[0]), &(statuses[0]) ));
MPI_ASSERT(MPI_Get_elements_x( &(statuses[0]), MPI_CHAR, &(ocount[0]) ));
}
}
if (rank==0) {
printf("ocount[0] = %lld \n", ocount[0]);
} else if ( rank==(size-1) ) {
printf("ocount[1] = %lld \n", ocount[1]);
}
/* correctness check */
if (rank==(size-1)) {
MPI_Count errors = 0;
for (MPI_Count i=0; i<count; i++)
errors += ( rbuf[i] != 'z' );
printf("errors = %lld \n", errors);
}
#ifdef USE_MPI_ALLOC_MEM
MPI_ASSERT(MPI_Free_mem(rbuf));
MPI_ASSERT(MPI_Free_mem(sbuf));
#else
free(rbuf);
free(sbuf);
#endif
MPI_ASSERT(MPI_Type_free(&bigtype));
MPI_ASSERT(MPI_Finalize());
return 0;
}
int main (int argc, char *argv[]) {
if(argc<3)
{
// printf("Usage: ./executables/mandelbrot <rows> <cols> (filename)\n");
return 0;
}
int rank, numprocs, err=0, i, j;
std::vector<std::string> v;
rows = atoi(argv[1]);
cols = atoi(argv[2]);
Matrix<double> img(rows, cols);
std::string filename;
if(argc > 3)
{
filename = argv[3];
filename += ".ppm";
}
std::chrono::high_resolution_clock::time_point start, end;
std::chrono::duration<double> time_span;
start = std::chrono::high_resolution_clock::now();
// Init MPI & get numprocs and rank
MPI_Init(&argc,&argv);
err = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
err = MPI_Comm_size(MPI_COMM_WORLD, &numprocs);
if(err){
fprintf(stderr,"Catastrophic MPI problem.\n");
MPI_Abort(MPI_COMM_WORLD,1);
}
Construct_MPI_Datatypes<double>(rows, cols);
if(rank == 0)
{
master<double>(numprocs, img);
}
slave<double>(numprocs);
std::cout<<"rank " <<rank <<" waiting at barrier\n";
MPI_Barrier(MPI_COMM_WORLD);
if(rank == 0)
{
end = std::chrono::high_resolution_clock::now();
time_span = std::chrono::duration_cast<std::chrono::duration<double>>(end - start);
printf("\nProgram exec time %dx%d image: %f seconds \n\n",rows, cols, (double)time_span.count());
if(argc > 3)
{
std::ofstream fout;
fout.open(filename, std::ofstream::out | std::ofstream::binary);
fout << "P3\n # Mandelbrot\n " << rows << " " <<cols << "\n 255\n";
double val;
int r, g, b;
for(i=0; i<=std::floor(rows/2.0); i++)
{
for(j=0; j<cols; j++)
{
val = std::abs(img[i][j]);
r = val * Palette[(int)val % 5][0];
g = val * Palette[(int)val % 5][1];
b = val * Palette[(int)val % 5][2];
fout << r << " " << g <<" " << b << " ";
}
fout <<"\n";
}
for(i=std::floor(rows/2.0); i>=0; i--)
{
for(j=0; j<cols; j++)
{
val = std::abs(img[i][j]);
r = val * Palette[(int)val % 5][0];
g = val * Palette[(int)val % 5][1];
b = val * Palette[(int)val % 5][2];
fout << r << " " << g <<" " << b << " ";
}
fout <<"\n";
}
fout.close();
}
}
// Free memory
MPI_Type_free(&MPI_Vector);
MPI_Finalize();
return 0;
}
/* builtin_struct_test()
*
* Tests behavior with a zero-count struct of builtins.
*
* Returns the number of errors encountered.
*/
int builtin_struct_test(void)
{
int err, errs = 0;
int count = 0;
MPI_Datatype newtype;
int size;
MPI_Aint extent;
err = MPI_Type_create_struct(count,
(int *) 0,
(MPI_Aint *) 0,
(MPI_Datatype *) 0,
&newtype);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr,
"error creating struct type in builtin_struct_test()\n");
}
errs++;
}
err = MPI_Type_size(newtype, &size);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr,
"error obtaining type size in builtin_struct_test()\n");
}
errs++;
}
if (size != 0) {
if (verbose) {
fprintf(stderr,
"error: size != 0 in builtin_struct_test()\n");
}
errs++;
}
err = MPI_Type_extent(newtype, &extent);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr,
"error obtaining type extent in builtin_struct_test()\n");
}
errs++;
}
if (extent != 0) {
if (verbose) {
fprintf(stderr,
"error: extent != 0 in builtin_struct_test()\n");
}
errs++;
}
MPI_Type_free( &newtype );
return errs;
}
/* optimizable_vector_of_basics_test()
*
* Builds a vector of ints. Count is 10, blocksize is 2, stride is 2, so this
* is equivalent to a contig of 20. But remember...we should get back our
* suboptimal values under MPI-2.
*
* Returns the number of errors encountered.
*/
int optimizable_vector_of_basics_test(void)
{
MPI_Datatype parent_type;
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_vector(10,
2,
2,
MPI_INT,
&parent_type);
/* decode */
err = MPI_Type_get_envelope(parent_type,
&nints,
&nadds,
&ntypes,
&combiner);
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr, "nints = %d; should be 3\n", nints);
if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes *sizeof(*types));
err = MPI_Type_get_contents(parent_type,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 10) errs++;
if (ints[1] != 2) errs++;
if (ints[2] != 2) errs++;
if (types[0] != MPI_INT) errs++;
if (verbose) {
if (ints[0] != 10) fprintf(stderr, "count = %d; should be 10\n",
ints[0]);
if (ints[1] != 2) fprintf(stderr, "blocklength = %d; should be 2\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr, "stride = %d; should be 2\n",
ints[2]);
if (types[0] != MPI_INT) fprintf(stderr, "type is not MPI_INT\n");
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &parent_type );
return errs;
}
/* indexed_of_basics_test(void)
*
* Simple indexed type.
*
* Returns number of errors encountered.
*/
int indexed_of_basics_test(void)
{
MPI_Datatype parent_type;
int s_count = 3, s_blocklengths[3] = { 3, 2, 1 };
int s_displacements[3] = { 10, 20, 30 };
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_indexed(s_count,
s_blocklengths,
s_displacements,
MPI_INT,
&parent_type);
/* decode */
err = MPI_Type_get_envelope(parent_type,
&nints,
&nadds,
&ntypes,
&combiner);
if (nints != 7) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_INDEXED) errs++;
if (verbose) {
if (nints != 7) fprintf(stderr, "nints = %d; should be 7\n", nints);
if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes);
if (combiner != MPI_COMBINER_INDEXED)
fprintf(stderr, "combiner = %s; should be indexed\n",
combiner_to_string(combiner));
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes *sizeof(*types));
err = MPI_Type_get_contents(parent_type,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != s_count) errs++;
if (ints[1] != s_blocklengths[0]) errs++;
if (ints[2] != s_blocklengths[1]) errs++;
if (ints[3] != s_blocklengths[2]) errs++;
if (ints[4] != s_displacements[0]) errs++;
if (ints[5] != s_displacements[1]) errs++;
if (ints[6] != s_displacements[2]) errs++;
if (types[0] != MPI_INT) errs++;
if (verbose) {
if (ints[0] != s_count)
fprintf(stderr, "count = %d; should be %d\n", ints[0], s_count);
if (ints[1] != s_blocklengths[0])
fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], s_blocklengths[0]);
if (ints[2] != s_blocklengths[1])
fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], s_blocklengths[1]);
if (ints[3] != s_blocklengths[2])
fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], s_blocklengths[2]);
if (ints[4] != s_displacements[0])
fprintf(stderr, "displacement[0] = %d; should be %d\n", ints[4], s_displacements[0]);
if (ints[5] != s_displacements[1])
fprintf(stderr, "displacement[1] = %d; should be %d\n", ints[5], s_displacements[1]);
if (ints[6] != s_displacements[2])
fprintf(stderr, "displacement[2] = %d; should be %d\n", ints[6], s_displacements[2]);
if (types[0] != MPI_INT) fprintf(stderr, "type[0] does not match\n");
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &parent_type );
return errs;
}
int convert_mpi_pvfs2_dtype(MPI_Datatype *mpi_dtype,
PVFS_Request *pvfs_dtype)
{
int num_int = -1, num_addr = -1, num_dtype = -1,
combiner = -1, i = -1, ret = -1, leaf = -1;
int *arr_int = NULL;
MPI_Aint *arr_addr = NULL;
MPI_Datatype *arr_dtype = NULL;
PVFS_Request *old_pvfs_dtype = NULL;
PVFS_Request *old_pvfs_dtype_arr = NULL;
int arr_count = -1;
PVFS_size *pvfs_arr_disp = NULL;
int *pvfs_arr_len = NULL;
MPI_Type_get_envelope(*mpi_dtype,
&num_int,
&num_addr,
&num_dtype,
&combiner);
/* Depending on type of datatype do the following
* operations */
if (combiner == MPI_COMBINER_NAMED)
{
convert_named(mpi_dtype, pvfs_dtype, combiner);
return 1;
}
/* Allocate space for the arrays necessary for
* MPI_Type_get_contents */
if ((arr_int = ADIOI_Malloc(sizeof(int)*num_int)) == NULL)
{
fprintf(stderr, "Failed to allocate array_int\n");
return -1;
}
if ((arr_addr = ADIOI_Malloc(sizeof(int)*num_addr)) == NULL)
{
ADIOI_Free(arr_int);
fprintf(stderr, "Failed to allocate array_addr\n");
return -1;
}
if ((arr_dtype = ADIOI_Malloc(sizeof(MPI_Datatype)*num_dtype)) == NULL)
{
ADIOI_Free(arr_int);
ADIOI_Free(arr_addr);
fprintf(stderr, "Failed to allocate array_dtypes\n");
return -1;
}
MPI_Type_get_contents(*mpi_dtype,
num_int,
num_addr,
num_dtype,
arr_int,
arr_addr,
arr_dtype);
/* If it's not a predefined datatype, it is either a
* derived datatype or a structured datatype */
if (combiner != MPI_COMBINER_STRUCT)
{
if ((old_pvfs_dtype = ADIOI_Malloc(sizeof(PVFS_Request))) == NULL)
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate PVFS_Request\n");
switch (combiner)
{
case MPI_COMBINER_CONTIGUOUS:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_contiguous(arr_int[0],
*old_pvfs_dtype, pvfs_dtype);
break;
case MPI_COMBINER_VECTOR:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_vector(arr_int[0], arr_int[1],
arr_int[2], *old_pvfs_dtype,
pvfs_dtype);
break;
case MPI_COMBINER_HVECTOR:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_hvector(arr_int[0], arr_int[1],
arr_addr[0], *old_pvfs_dtype,
pvfs_dtype);
break;
/* Both INDEXED and HINDEXED types require PVFS_size
* address arrays. Therefore, we need to copy and
* convert the data from MPI_get_contents() into
* a PVFS_size buffer */
case MPI_COMBINER_INDEXED:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
if ((pvfs_arr_disp =
ADIOI_Malloc(arr_int[0]*sizeof(PVFS_size))) == 0)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_disp\n");
}
for (i = 0; i < arr_int[0]; i++)
{
pvfs_arr_disp[i] =
(PVFS_size) arr_int[arr_int[0]+1+i];
}
ret = PVFS_Request_indexed(arr_int[0], &arr_int[1],
pvfs_arr_disp,
*old_pvfs_dtype, pvfs_dtype);
ADIOI_Free(pvfs_arr_disp);
break;
case MPI_COMBINER_HINDEXED:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
if ((pvfs_arr_disp =
ADIOI_Malloc(arr_int[0]*sizeof(PVFS_size))) == 0)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_disp\n");
}
for (i = 0; i < arr_int[0]; i++)
{
pvfs_arr_disp[i] =
(PVFS_size) arr_addr[i];
}
ret = PVFS_Request_hindexed(arr_int[0], &arr_int[1],
(int64_t *)&arr_addr[0],
*old_pvfs_dtype, pvfs_dtype);
ADIOI_Free(pvfs_arr_disp);
break;
case MPI_COMBINER_DUP:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_contiguous(1,
*old_pvfs_dtype, pvfs_dtype);
break;
case MPI_COMBINER_INDEXED_BLOCK:
/* No native PVFS2 support for this operation currently */
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"INDEXED_BLOCK is unsupported\n");
break;
case MPI_COMBINER_HINDEXED_BLOCK:
/* No native PVFS2 support for this operation currently */
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"HINDEXED_BLOCK is unsupported\n");
break;
case MPI_COMBINER_HINDEXED_INTEGER:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"HINDEXED_INTEGER is unsupported\n");
break;
case MPI_COMBINER_STRUCT_INTEGER:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"STRUCT_INTEGER is unsupported\n");
break;
case MPI_COMBINER_SUBARRAY:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"SUBARRAY is unsupported\n");
break;
case MPI_COMBINER_DARRAY:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"DARRAY is unsupported\n");
break;
case MPI_COMBINER_F90_REAL:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"F90_REAL is unsupported\n");
break;
case MPI_COMBINER_F90_COMPLEX:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"F90_COMPLEX is unsupported\n");
break;
case MPI_COMBINER_F90_INTEGER:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"F90_INTEGER is unsupported\n");
break;
case MPI_COMBINER_RESIZED:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"RESIZED is unsupported\n");
break;
default:
break;
}
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_* "
"for a derived datatype\n");
#ifdef DEBUG_DTYPE
print_dtype_info(combiner,
num_int,
num_addr,
num_dtype,
arr_int,
arr_addr,
arr_dtype);
#endif
if (leaf != 1 && combiner != MPI_COMBINER_DUP)
MPI_Type_free(&arr_dtype[0]);
ADIOI_Free(arr_int);
ADIOI_Free(arr_addr);
ADIOI_Free(arr_dtype);
PVFS_Request_free(old_pvfs_dtype);
ADIOI_Free(old_pvfs_dtype);
return ret;
}
else /* MPI_COMBINER_STRUCT */
{
MPI_Aint mpi_lb = -1, mpi_extent = -1;
PVFS_offset pvfs_lb = -1;
PVFS_size pvfs_extent = -1;
int has_lb_ub = 0;
/* When converting into a PVFS_Request_struct, we no longer
* can use MPI_LB and MPI_UB. Therfore, we have to do the
* following.
* We simply ignore all the MPI_LB and MPI_UB types and
* get the lb and extent and pass it on through a
* PVFS resized_req */
arr_count = 0;
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
{
arr_count++;
}
}
if (arr_int[0] != arr_count)
{
MPI_Type_get_extent(*mpi_dtype, &mpi_lb, &mpi_extent);
pvfs_lb = mpi_lb;
pvfs_extent = mpi_extent;
if ((pvfs_arr_len = ADIOI_Malloc(arr_count*sizeof(int)))
== NULL)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_len\n");
}
has_lb_ub = 1;
}
if ((old_pvfs_dtype_arr
= ADIOI_Malloc(arr_count*sizeof(PVFS_Request))) == NULL)
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate PVFS_Requests\n");
if ((pvfs_arr_disp = ADIOI_Malloc(arr_count*sizeof(PVFS_size)))
== NULL)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_disp\n");
}
arr_count = 0;
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
{
leaf = convert_mpi_pvfs2_dtype(
&arr_dtype[i], &old_pvfs_dtype_arr[arr_count]);
if (leaf != 1)
MPI_Type_free(&arr_dtype[i]);
pvfs_arr_disp[arr_count] =
(PVFS_size) arr_addr[i];
if (has_lb_ub)
{
pvfs_arr_len[arr_count] =
arr_int[i+1];
}
arr_count++;
}
}
/* If a MPI_UB or MPI_LB did exist, we have to
* resize the datatype */
if (has_lb_ub)
{
PVFS_Request *tmp_pvfs_dtype = NULL;
if ((tmp_pvfs_dtype = ADIOI_Malloc(sizeof(PVFS_Request))) == NULL)
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate PVFS_Request\n");
ret = PVFS_Request_struct(arr_count, pvfs_arr_len,
pvfs_arr_disp,
old_pvfs_dtype_arr, tmp_pvfs_dtype);
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_struct\n");
arr_count = 0;
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
{
PVFS_Request_free(&old_pvfs_dtype_arr[arr_count]);
arr_count++;
}
}
#ifdef DEBUG_DTYPE
fprintf(stderr, "STRUCT(WITHOUT %d LB or UB)(%d,[",
arr_int[0] - arr_count, arr_count);
for (i = 0; i < arr_count; i++)
fprintf(stderr, "(%d,%Ld) ",
pvfs_arr_len[i],
pvfs_arr_disp[i]);
fprintf(stderr, "]\n");
fprintf(stderr, "RESIZED(LB = %Ld, EXTENT = %Ld)\n",
pvfs_lb, pvfs_extent);
#endif
ret = PVFS_Request_resized(*tmp_pvfs_dtype,
pvfs_lb, pvfs_extent, pvfs_dtype);
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_resize\n");
PVFS_Request_free(tmp_pvfs_dtype);
ADIOI_Free(tmp_pvfs_dtype);
}
else /* No MPI_LB or MPI_UB datatypes */
{
ret = PVFS_Request_struct(arr_int[0], &arr_int[1],
pvfs_arr_disp,
old_pvfs_dtype_arr, pvfs_dtype);
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_struct\n");
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
PVFS_Request_free(&old_pvfs_dtype_arr[i]);
}
#ifdef DEBUG_DTYPE
print_dtype_info(combiner,
num_int,
num_addr,
num_dtype,
arr_int,
arr_addr,
arr_dtype);
#endif
}
ADIOI_Free(arr_int);
ADIOI_Free(arr_addr);
ADIOI_Free(arr_dtype);
ADIOI_Free(old_pvfs_dtype_arr);
ADIOI_Free(pvfs_arr_disp);
ADIOI_Free(pvfs_arr_len);
return ret;
}
/* Shouldn't have gotten here */
fprintf(stderr, "convert_mpi_pvfs2_dtype: SERIOUS ERROR\n");
return -1;
}
/* vector_of_vectors_test()
*
* Builds a vector of a vector of ints. Assuming an int array of size 9
* integers, and treating the array as a 3x3 2D array, this will grab the
* corners.
*
* MPICH1 fails this test because it converts the vectors into hvectors.
*
* Returns the number of errors encountered.
*/
int vector_of_vectors_test(void)
{
MPI_Datatype inner_vector, inner_vector_copy;
MPI_Datatype outer_vector;
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_vector(2,
1,
2,
MPI_INT,
&inner_vector);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
err = MPI_Type_vector(2,
1,
2,
inner_vector,
&outer_vector);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
/* decode outer vector (get envelope, then contents) */
err = MPI_Type_get_envelope(outer_vector,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr,
"outer vector nints = %d; should be 3\n",
nints);
if (nadds != 0) fprintf(stderr,
"outer vector nadds = %d; should be 0\n",
nadds);
if (ntypes != 1) fprintf(stderr,
"outer vector ntypes = %d; should be 1\n",
ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "outer vector combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
/* get contents of outer vector */
err = MPI_Type_get_contents(outer_vector,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 2) errs++;
if (ints[1] != 1) errs++;
if (ints[2] != 2) errs++;
if (verbose) {
if (ints[0] != 2) fprintf(stderr,
"outer vector count = %d; should be 2\n",
ints[0]);
if (ints[1] != 1) fprintf(stderr,
"outer vector blocklength = %d; should be 1\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr, "outer vector stride = %d; should be 2\n",
ints[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
inner_vector_copy = types[0];
free(ints);
if (nadds) free(adds);
free(types);
/* decode inner vector */
err = MPI_Type_get_envelope(inner_vector_copy,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr,
"inner vector nints = %d; should be 3\n",
nints);
if (nadds != 0) fprintf(stderr,
"inner vector nadds = %d; should be 0\n",
nadds);
if (ntypes != 1) fprintf(stderr,
"inner vector ntypes = %d; should be 1\n",
ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "inner vector combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
err = MPI_Type_get_contents(inner_vector_copy,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 2) errs++;
if (ints[1] != 1) errs++;
if (ints[2] != 2) errs++;
if (verbose) {
if (ints[0] != 2) fprintf(stderr,
"inner vector count = %d; should be 2\n",
ints[0]);
if (ints[1] != 1) fprintf(stderr,
"inner vector blocklength = %d; should be 1\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr,
"inner vector stride = %d; should be 2\n",
ints[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &inner_vector_copy );
MPI_Type_free( &inner_vector );
MPI_Type_free( &outer_vector );
return 0;
}
int amps_unpack(
amps_Comm comm,
amps_Invoice inv,
char *buffer,
int buf_size)
{
amps_InvoiceEntry *ptr;
int len, stride;
int malloced = FALSE;
int size;
char *data;
char *temp_pos;
int dim;
MPI_Datatype mpi_type;
MPI_Datatype *base_type;
MPI_Datatype *new_type;
MPI_Datatype *temp_type;
int element_size = 0;
int position;
int base_size;
int i;
/* we are unpacking so signal this operation */
inv -> flags &= ~AMPS_PACKED;
/* for each entry in the invoice pack that entry into the letter */
ptr = inv -> list;
position = 0;
while(ptr != NULL)
{
/* invoke the packing convert out for the entry */
/* if user then call user ones */
/* else switch on builtin type */
if(ptr -> len_type == AMPS_INVOICE_POINTER)
len = *(ptr -> ptr_len);
else
len = ptr ->len;
if(ptr -> stride_type == AMPS_INVOICE_POINTER)
stride = *(ptr -> ptr_stride);
else
stride = ptr -> stride;
switch(ptr->type)
{
case AMPS_INVOICE_CHAR_CTYPE:
if(!ptr->ignore)
{
if( ptr -> data_type == AMPS_INVOICE_POINTER)
{
*((void **)(ptr -> data)) = malloc(sizeof(char) *
(size_t)(len*stride));
malloced = TRUE;
MPI_Type_vector(len, 1, stride, MPI_BYTE, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
*((void **)(ptr -> data)), 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
else
{
MPI_Type_vector(len, 1, stride, MPI_BYTE, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
ptr -> data, 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
}
break;
case AMPS_INVOICE_SHORT_CTYPE:
if(!ptr->ignore)
{
if( ptr -> data_type == AMPS_INVOICE_POINTER)
{
*((void **)(ptr -> data)) = malloc(sizeof(short) *
(size_t)(len*stride));
malloced = TRUE;
MPI_Type_vector(len, 1, stride, MPI_SHORT, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
*((void **)(ptr -> data)), 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
else
{
MPI_Type_vector(len, 1, stride, MPI_SHORT, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
ptr -> data, 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
}
break;
case AMPS_INVOICE_INT_CTYPE:
if(!ptr->ignore)
{
if( ptr -> data_type == AMPS_INVOICE_POINTER)
{
*((void **)(ptr -> data)) = malloc(sizeof(int)*
(size_t)(len*stride));
malloced = TRUE;
MPI_Type_vector(len, 1, stride, MPI_INT, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
*((void **)(ptr -> data)), 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
else
{
MPI_Type_vector(len, 1, stride, MPI_INT, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
ptr -> data, 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
}
break;
case AMPS_INVOICE_LONG_CTYPE:
if(!ptr->ignore)
{
if( ptr -> data_type == AMPS_INVOICE_POINTER)
{
*((void **)(ptr -> data)) = malloc(sizeof(long)*
(size_t)(len*stride));
malloced = TRUE;
MPI_Type_vector(len, 1, stride, MPI_LONG, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
*((void **)(ptr -> data)), 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
else
{
MPI_Type_vector(len, 1, stride, MPI_LONG, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
ptr -> data, 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
}
break;
case AMPS_INVOICE_FLOAT_CTYPE:
if(!ptr->ignore)
{
if( ptr -> data_type == AMPS_INVOICE_POINTER)
{
*((void **)(ptr -> data)) = malloc(sizeof(float)*
(size_t)(len*stride));
malloced = TRUE;
MPI_Type_vector(len, 1, stride, MPI_FLOAT, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
*((void **)(ptr -> data)), 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
else
{
MPI_Type_vector(len, 1, stride, MPI_FLOAT, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
ptr -> data, 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
}
break;
case AMPS_INVOICE_DOUBLE_CTYPE:
if(!ptr->ignore)
{
if( ptr -> data_type == AMPS_INVOICE_POINTER)
{
*((void **)(ptr -> data)) = malloc(sizeof(double)*
(size_t)(len*stride));
malloced = TRUE;
MPI_Type_vector(len, 1, stride, MPI_DOUBLE, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
*((void **)(ptr -> data)), 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
else
{
MPI_Type_vector(len, 1, stride, MPI_DOUBLE, &mpi_type);
MPI_Type_commit(&mpi_type);
MPI_Unpack(buffer, buf_size, &position,
ptr -> data, 1, mpi_type, comm);
MPI_Type_free(&mpi_type);
}
}
break;
default:
dim = ( ptr -> dim_type == AMPS_INVOICE_POINTER) ?
*(ptr -> ptr_dim) : ptr -> dim;
size = amps_vector_sizeof_local( comm,
ptr -> type - AMPS_INVOICE_LAST_CTYPE,
NULL, &temp_pos, dim,
ptr -> ptr_len, ptr -> ptr_stride);
if( ptr -> data_type == AMPS_INVOICE_POINTER )
data = *(char **)(ptr -> data) = (char *)malloc((size_t)(size));
else
data = (char *)ptr -> data;
base_type = (MPI_Datatype *)calloc(1, sizeof(MPI_Datatype));
new_type = (MPI_Datatype *)calloc(1, sizeof(MPI_Datatype));
len = ptr -> ptr_len[0];
stride = ptr -> ptr_stride[0];
switch(ptr -> type - AMPS_INVOICE_LAST_CTYPE)
{
case AMPS_INVOICE_CHAR_CTYPE:
if(!ptr->ignore)
{
MPI_Type_vector(len, 1, stride, MPI_BYTE, base_type);
element_size = sizeof(char);
}
break;
case AMPS_INVOICE_SHORT_CTYPE:
if(!ptr->ignore)
{
MPI_Type_vector(len, 1, stride, MPI_SHORT, base_type);
element_size = sizeof(short);
}
break;
case AMPS_INVOICE_INT_CTYPE:
if(!ptr->ignore)
{
MPI_Type_vector(len, 1, stride, MPI_INT, base_type);
element_size = sizeof(int);
}
break;
case AMPS_INVOICE_LONG_CTYPE:
if(!ptr->ignore)
{
MPI_Type_vector(len, 1, stride, MPI_LONG, base_type);
element_size = sizeof(long);
}
break;
case AMPS_INVOICE_FLOAT_CTYPE:
if(!ptr->ignore)
{
MPI_Type_vector(len, 1, stride, MPI_FLOAT, base_type);
element_size = sizeof(float);
}
break;
case AMPS_INVOICE_DOUBLE_CTYPE:
if(!ptr->ignore)
{
MPI_Type_vector(len, 1, stride, MPI_DOUBLE, base_type);
element_size = sizeof(double);
}
break;
}
base_size = element_size*( len + (len - 1) * (stride-1));
for(i = 1; i < dim; i++)
{
MPI_Type_hvector(ptr -> ptr_len[i], 1,
base_size +
(ptr -> ptr_stride[i]-1) * element_size,
*base_type, new_type);
base_size = base_size*ptr -> ptr_len[i]
+ (ptr -> ptr_stride[i]-1)*(ptr->ptr_len[i] - 1)*element_size;
MPI_Type_free(base_type);
temp_type = base_type;
base_type = new_type;
new_type = temp_type;
}
MPI_Type_commit(base_type);
MPI_Unpack(buffer, size, &position, data, 1, *base_type, comm);
MPI_Type_free(base_type);
free(base_type);
free(new_type);
}
ptr = ptr -> next;
}
if(malloced)
{
inv -> combuf_flags |= AMPS_INVOICE_OVERLAYED;
inv -> combuf = buffer;
inv -> comm = comm;
}
return 0;
}
/*@C
PetscFinalize - Checks for options to be called at the conclusion
of the program. MPI_Finalize() is called only if the user had not
called MPI_Init() before calling PetscInitialize().
Collective on PETSC_COMM_WORLD
Options Database Keys:
+ -options_table - Calls PetscOptionsView()
. -options_left - Prints unused options that remain in the database
. -objects_dump [all] - Prints list of objects allocated by the user that have not been freed, the option all cause all outstanding objects to be listed
. -mpidump - Calls PetscMPIDump()
. -malloc_dump - Calls PetscMallocDump()
. -malloc_info - Prints total memory usage
- -malloc_log - Prints summary of memory usage
Level: beginner
Note:
See PetscInitialize() for more general runtime options.
.seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
@*/
PetscErrorCode PetscFinalize(void)
{
PetscErrorCode ierr;
PetscMPIInt rank;
PetscInt nopt;
PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
#if defined(PETSC_HAVE_AMS)
PetscBool flg = PETSC_FALSE;
#endif
#if defined(PETSC_USE_LOG)
char mname[PETSC_MAX_PATH_LEN];
#endif
PetscFunctionBegin;
if (!PetscInitializeCalled) {
printf("PetscInitialize() must be called before PetscFinalize()\n");
PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE);
}
ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr);
#if defined(PETSC_SERIALIZE_FUNCTIONS)
ierr = PetscFPTDestroy();CHKERRQ(ierr);
#endif
#if defined(PETSC_HAVE_AMS)
ierr = PetscOptionsGetBool(NULL,"-options_gui",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = PetscOptionsAMSDestroy();CHKERRQ(ierr);
}
#endif
#if defined(PETSC_HAVE_SERVER)
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-server",&flg1,NULL);CHKERRQ(ierr);
if (flg1) {
/* this is a crude hack, but better than nothing */
ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 petscwebserver","r",NULL);CHKERRQ(ierr);
}
#endif
ierr = PetscHMPIFinalize();CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr);
if (!flg2) {
flg2 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-memory_info",&flg2,NULL);CHKERRQ(ierr);
}
if (flg2) {
ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr);
}
#if defined(PETSC_USE_LOG)
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr);
if (flg1) {
PetscLogDouble flops = 0;
ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr);
}
#endif
#if defined(PETSC_USE_LOG)
#if defined(PETSC_HAVE_MPE)
mname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
if (flg1) {
if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);}
else {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);}
}
#endif
mname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
if (flg1) {
PetscViewer viewer;
if (mname[0]) {
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
ierr = PetscLogView(viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
} else {
viewer = PETSC_VIEWER_STDOUT_WORLD;
ierr = PetscLogView(viewer);CHKERRQ(ierr);
}
}
mname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-log_summary_python",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
if (flg1) {
PetscViewer viewer;
if (mname[0]) {
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
ierr = PetscLogViewPython(viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
} else {
viewer = PETSC_VIEWER_STDOUT_WORLD;
ierr = PetscLogViewPython(viewer);CHKERRQ(ierr);
}
}
ierr = PetscOptionsGetString(NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
if (flg1) {
if (mname[0]) {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);}
else {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,0);CHKERRQ(ierr);}
}
mname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
ierr = PetscOptionsGetString(NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr);
if (flg1 || flg2) {
if (mname[0]) PetscLogDump(mname);
else PetscLogDump(0);
}
#endif
/*
Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
*/
ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr);
ierr = PetscStackDestroy();CHKERRQ(ierr);
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr);
if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);}
flg1 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr);
if (flg1) {
ierr = PetscMPIDump(stdout);CHKERRQ(ierr);
}
flg1 = PETSC_FALSE;
flg2 = PETSC_FALSE;
/* preemptive call to avoid listing this option in options table as unused */
ierr = PetscOptionsHasName(NULL,"-malloc_dump",&flg1);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-options_table",&flg2,NULL);CHKERRQ(ierr);
if (flg2) {
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* to prevent PETSc -options_left from warning */
ierr = PetscOptionsHasName(NULL,"-nox",&flg1);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-nox_warning",&flg1);CHKERRQ(ierr);
if (!PetscHMPIWorker) { /* worker processes skip this because they do not usually process options */
flg3 = PETSC_FALSE; /* default value is required */
ierr = PetscOptionsGetBool(NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr);
ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr);
if (flg3) {
if (!flg2) { /* have not yet printed the options */
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
if (!nopt) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr);
} else if (nopt == 1) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr);
}
}
#if defined(PETSC_USE_DEBUG)
if (nopt && !flg3 && !flg1) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr);
ierr = PetscOptionsLeft();CHKERRQ(ierr);
} else if (nopt && flg3) {
#else
if (nopt && flg3) {
#endif
ierr = PetscOptionsLeft();CHKERRQ(ierr);
}
}
{
PetscThreadComm tcomm_world;
ierr = PetscGetThreadCommWorld(&tcomm_world);CHKERRQ(ierr);
/* Free global thread communicator */
ierr = PetscThreadCommDestroy(&tcomm_world);CHKERRQ(ierr);
}
/*
List all objects the user may have forgot to free
*/
ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
if (flg1) {
MPI_Comm local_comm;
char string[64];
ierr = PetscOptionsGetString(NULL,"-objects_dump",string,64,NULL);CHKERRQ(ierr);
ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
}
PetscObjectsCounts = 0;
PetscObjectsMaxCounts = 0;
ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
#if defined(PETSC_USE_LOG)
ierr = PetscLogDestroy();CHKERRQ(ierr);
#endif
/*
Destroy any packages that registered a finalize
*/
ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr);
/*
Destroy all the function registration lists created
*/
ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr);
/*
Print PetscFunctionLists that have not been properly freed
ierr = PetscFunctionListPrintAll();CHKERRQ(ierr);
*/
if (petsc_history) {
ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr);
petsc_history = 0;
}
ierr = PetscInfoAllow(PETSC_FALSE,NULL);CHKERRQ(ierr);
{
char fname[PETSC_MAX_PATH_LEN];
FILE *fd;
int err;
fname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr);
flg2 = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr);
#if defined(PETSC_USE_DEBUG)
if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE;
#else
flg2 = PETSC_FALSE; /* Skip reporting for optimized builds regardless of -malloc_test */
#endif
if (flg1 && fname[0]) {
char sname[PETSC_MAX_PATH_LEN];
sprintf(sname,"%s_%d",fname,rank);
fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
ierr = PetscMallocDump(fd);CHKERRQ(ierr);
err = fclose(fd);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
} else if (flg1 || flg2) {
MPI_Comm local_comm;
ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
ierr = PetscMallocDump(stdout);CHKERRQ(ierr);
ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
}
}
{
char fname[PETSC_MAX_PATH_LEN];
FILE *fd = NULL;
fname[0] = 0;
ierr = PetscOptionsGetString(NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr);
if (flg1 && fname[0]) {
int err;
if (!rank) {
fd = fopen(fname,"w");
if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname);
}
ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr);
if (fd) {
err = fclose(fd);
if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
}
} else if (flg1 || flg2) {
ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr);
}
}
/* Can be destroyed only after all the options are used */
ierr = PetscOptionsDestroy();CHKERRQ(ierr);
PetscGlobalArgc = 0;
PetscGlobalArgs = 0;
#if defined(PETSC_USE_REAL___FLOAT128)
ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr);
#if defined(PETSC_HAVE_COMPLEX)
ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr);
#endif
ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr);
ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr);
#endif
#if defined(PETSC_HAVE_COMPLEX)
#if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr);
#endif
#endif
#if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr);
#endif
ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr);
#if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr);
#endif
ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr);
ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr);
ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr);
/*
Destroy any known inner MPI_Comm's and attributes pointing to them
Note this will not destroy any new communicators the user has created.
If all PETSc objects were not destroyed those left over objects will have hanging references to
the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
*/
{
PetscCommCounter *counter;
PetscMPIInt flg;
MPI_Comm icomm;
union {MPI_Comm comm; void *ptr;} ucomm;
ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr);
if (flg) {
icomm = ucomm.comm;
ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr);
ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
}
ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr);
if (flg) {
icomm = ucomm.comm;
ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr);
ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
}
}
ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr);
ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr);
ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr);
#if defined(PETSC_HAVE_CUDA)
{
PetscInt p;
for (p = 0; p < PetscGlobalSize; ++p) {
if (p == PetscGlobalRank) cublasShutdown();
ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
}
}
#endif
if (PetscBeganMPI) {
#if defined(PETSC_HAVE_MPI_FINALIZED)
PetscMPIInt flag;
ierr = MPI_Finalized(&flag);CHKERRQ(ierr);
if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
#endif
ierr = MPI_Finalize();CHKERRQ(ierr);
}
/*
Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
the communicator has some outstanding requests on it. Specifically if the
flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
is never freed as it should be. Thus one may obtain messages of the form
[ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
memory was not freed.
*/
ierr = PetscMallocClear();CHKERRQ(ierr);
PetscInitializeCalled = PETSC_FALSE;
PetscFinalizeCalled = PETSC_TRUE;
PetscFunctionReturn(ierr);
}
#if defined(PETSC_MISSING_LAPACK_lsame_)
PETSC_EXTERN int lsame_(char *a,char *b)
{
if (*a == *b) return 1;
if (*a + 32 == *b) return 1;
if (*a - 32 == *b) return 1;
return 0;
}
#endif
#if defined(PETSC_MISSING_LAPACK_lsame)
PETSC_EXTERN int lsame(char *a,char *b)
{
if (*a == *b) return 1;
if (*a + 32 == *b) return 1;
if (*a - 32 == *b) return 1;
return 0;
}
int main(int argc, char **argv) {
int i, j, rank, nranks, peer, bufsize, errors;
double *win_buf, *src_buf;
MPI_Win buf_win;
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &nranks);
bufsize = XDIM * YDIM * sizeof(double);
MPI_Alloc_mem(bufsize, MPI_INFO_NULL, &win_buf);
MPI_Alloc_mem(bufsize, MPI_INFO_NULL, &src_buf);
if (rank == 0)
if (verbose) printf("MPI RMA Strided Accumulate Test:\n");
for (i = 0; i < XDIM*YDIM; i++) {
*(win_buf + i) = -1.0;
*(src_buf + i) = 1.0 + rank;
}
MPI_Win_create(win_buf, bufsize, 1, MPI_INFO_NULL, MPI_COMM_WORLD, &buf_win);
peer = (rank+1) % nranks;
/* Perform ITERATIONS strided accumulate operations */
for (i = 0; i < ITERATIONS; i++) {
int ndims = 2;
int src_arr_sizes[2] = { XDIM, YDIM };
int src_arr_subsizes[2] = { SUB_XDIM, SUB_YDIM };
int src_arr_starts[2] = { 0, 0 };
int dst_arr_sizes[2] = { XDIM, YDIM };
int dst_arr_subsizes[2] = { SUB_XDIM, SUB_YDIM };
int dst_arr_starts[2] = { 0, 0 };
MPI_Datatype src_type, dst_type;
MPI_Type_create_subarray(ndims, src_arr_sizes, src_arr_subsizes, src_arr_starts,
MPI_ORDER_C, MPI_DOUBLE, &src_type);
MPI_Type_create_subarray(ndims, dst_arr_sizes, dst_arr_subsizes, dst_arr_starts,
MPI_ORDER_C, MPI_DOUBLE, &dst_type);
MPI_Type_commit(&src_type);
MPI_Type_commit(&dst_type);
MPI_Win_lock(MPI_LOCK_EXCLUSIVE, peer, 0, buf_win);
MPI_Accumulate(src_buf, 1, src_type, peer, 0, 1, dst_type, MPI_SUM, buf_win);
MPI_Win_unlock(peer, buf_win);
MPI_Type_free(&src_type);
MPI_Type_free(&dst_type);
}
MPI_Barrier(MPI_COMM_WORLD);
/* Verify that the results are correct */
MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, buf_win);
errors = 0;
for (i = 0; i < SUB_XDIM; i++) {
for (j = 0; j < SUB_YDIM; j++) {
const double actual = *(win_buf + i + j*XDIM);
const double expected = -1.0 + (1.0 + ((rank+nranks-1)%nranks)) * (ITERATIONS);
if (fabs(actual - expected) > 1.0e-10) {
SQUELCH( printf("%d: Data validation failed at [%d, %d] expected=%f actual=%f\n",
rank, j, i, expected, actual); );
errors++;
fflush(stdout);
}
}
void ADIOI_HFS_Fcntl(ADIO_File fd, int flag, ADIO_Fcntl_t *fcntl_struct, int *error_code)
{
MPI_Datatype copy_etype, copy_filetype;
int combiner, i, j, k, filetype_is_contig, ntimes, err;
ADIOI_Flatlist_node *flat_file;
ADIO_Offset curr_fsize, alloc_size, size, len, done;
ADIO_Status status;
char *buf;
#ifndef PRINT_ERR_MSG
static char myname[] = "ADIOI_HFS_FCNTL";
#endif
switch(flag) {
case ADIO_FCNTL_SET_VIEW:
/* free copies of old etypes and filetypes and delete flattened
version of filetype if necessary */
MPI_Type_get_envelope(fd->etype, &i, &j, &k, &combiner);
if (combiner != MPI_COMBINER_NAMED) MPI_Type_free(&(fd->etype));
ADIOI_Datatype_iscontig(fd->filetype, &filetype_is_contig);
if (!filetype_is_contig) ADIOI_Delete_flattened(fd->filetype);
MPI_Type_get_envelope(fd->filetype, &i, &j, &k, &combiner);
if (combiner != MPI_COMBINER_NAMED) MPI_Type_free(&(fd->filetype));
/* set new info */
ADIO_SetInfo(fd, fcntl_struct->info, &err);
/* set new etypes and filetypes */
MPI_Type_get_envelope(fcntl_struct->etype, &i, &j, &k, &combiner);
if (combiner == MPI_COMBINER_NAMED) fd->etype = fcntl_struct->etype;
else {
MPI_Type_contiguous(1, fcntl_struct->etype, ©_etype);
MPI_Type_commit(©_etype);
fd->etype = copy_etype;
}
MPI_Type_get_envelope(fcntl_struct->filetype, &i, &j, &k, &combiner);
if (combiner == MPI_COMBINER_NAMED)
fd->filetype = fcntl_struct->filetype;
else {
MPI_Type_contiguous(1, fcntl_struct->filetype, ©_filetype);
MPI_Type_commit(©_filetype);
fd->filetype = copy_filetype;
ADIOI_Flatten_datatype(fd->filetype);
/* this function will not flatten the filetype if it turns out
to be all contiguous. */
}
MPI_Type_size(fd->etype, &(fd->etype_size));
fd->disp = fcntl_struct->disp;
/* reset MPI-IO file pointer to point to the first byte that can
be accessed in this view. */
ADIOI_Datatype_iscontig(fd->filetype, &filetype_is_contig);
if (filetype_is_contig) fd->fp_ind = fcntl_struct->disp;
else {
flat_file = ADIOI_Flatlist;
while (flat_file->type != fd->filetype)
flat_file = flat_file->next;
for (i=0; i<flat_file->count; i++) {
if (flat_file->blocklens[i]) {
fd->fp_ind = fcntl_struct->disp + flat_file->indices[i];
break;
}
}
}
*error_code = MPI_SUCCESS;
break;
case ADIO_FCNTL_GET_FSIZE:
fcntl_struct->fsize = lseek64(fd->fd_sys, 0, SEEK_END);
#ifdef PRINT_ERR_MSG
*error_code = (fcntl_struct->fsize == -1) ? MPI_ERR_UNKNOWN : MPI_SUCCESS;
#else
if (fcntl_struct->fsize == -1) {
*error_code = MPIR_Err_setmsg(MPI_ERR_IO, MPIR_ADIO_ERROR,
myname, "I/O Error", "%s", strerror(errno));
ADIOI_Error(fd, *error_code, myname);
}
else *error_code = MPI_SUCCESS;
#endif
break;
case ADIO_FCNTL_SET_DISKSPACE:
/* will be called by one process only */
#ifdef SPPUX
/* SPPUX has no prealloc64. therefore, use prealloc
if size < (2GB - 1), otherwise use long method. */
if (fcntl_struct->diskspace <= 2147483647) {
err = prealloc(fd->fd_sys, (off_t) fcntl_struct->diskspace);
if (err && (errno != ENOTEMPTY)) {
#ifdef PRINT_ERR_MSG
*error_code = MPI_ERR_UNKNOWN;
#else
*error_code = MPIR_Err_setmsg(MPI_ERR_IO, MPIR_ADIO_ERROR,
myname, "I/O Error", "%s", strerror(errno));
ADIOI_Error(fd, *error_code, myname);
#endif
return;
}
}
if ((fcntl_struct->diskspace > 2147483647) ||
(err && (errno == ENOTEMPTY))) {
#endif
/* Explicitly write to allocate space. Since there could be
holes in the file, I need to read up to the current file
size, write it back, and then write beyond that depending
on how much preallocation is needed.
read/write in sizes of no more than ADIOI_PREALLOC_BUFSZ */
curr_fsize = lseek64(fd->fd_sys, 0, SEEK_END);
alloc_size = fcntl_struct->diskspace;
size = ADIOI_MIN(curr_fsize, alloc_size);
ntimes = (size + ADIOI_PREALLOC_BUFSZ - 1)/ADIOI_PREALLOC_BUFSZ;
buf = (char *) ADIOI_Malloc(ADIOI_PREALLOC_BUFSZ);
done = 0;
for (i=0; i<ntimes; i++) {
len = ADIOI_MIN(size-done, ADIOI_PREALLOC_BUFSZ);
ADIO_ReadContig(fd, buf, len, MPI_BYTE, ADIO_EXPLICIT_OFFSET,
done, &status, error_code);
if (*error_code != MPI_SUCCESS) {
#ifdef PRINT_ERR_MSG
FPRINTF(stderr, "ADIOI_HFS_Fcntl: To preallocate disk space, ROMIO needs to read the file and write it back, but is unable to read the file. Please give the file read permission and open it with MPI_MODE_RDWR.\n");
MPI_Abort(MPI_COMM_WORLD, 1);
#else
*error_code = MPIR_Err_setmsg(MPI_ERR_IO, MPIR_PREALLOC_PERM,
myname, (char *) 0, (char *) 0);
ADIOI_Error(fd, *error_code, myname);
return;
#endif
}
ADIO_WriteContig(fd, buf, len, MPI_BYTE, ADIO_EXPLICIT_OFFSET,
done, &status, error_code);
if (*error_code != MPI_SUCCESS) return;
done += len;
}
if (alloc_size > curr_fsize) {
memset(buf, 0, ADIOI_PREALLOC_BUFSZ);
size = alloc_size - curr_fsize;
ntimes = (size + ADIOI_PREALLOC_BUFSZ - 1)/ADIOI_PREALLOC_BUFSZ;
for (i=0; i<ntimes; i++) {
len = ADIOI_MIN(alloc_size-done, ADIOI_PREALLOC_BUFSZ);
ADIO_WriteContig(fd, buf, len, MPI_BYTE, ADIO_EXPLICIT_OFFSET,
done, &status, error_code);
if (*error_code != MPI_SUCCESS) return;
done += len;
}
}
ADIOI_Free(buf);
#ifdef SPPUX
}
#endif
*error_code = MPI_SUCCESS;
break;
case ADIO_FCNTL_SET_IOMODE:
/* for implementing PFS I/O modes. will not occur in MPI-IO
implementation.*/
if (fd->iomode != fcntl_struct->iomode) {
fd->iomode = fcntl_struct->iomode;
MPI_Barrier(MPI_COMM_WORLD);
}
*error_code = MPI_SUCCESS;
break;
case ADIO_FCNTL_SET_ATOMICITY:
fd->atomicity = (fcntl_struct->atomicity == 0) ? 0 : 1;
*error_code = MPI_SUCCESS;
break;
default:
FPRINTF(stderr, "Unknown flag passed to ADIOI_HFS_Fcntl\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
}
/* indexed_of_vectors_test()
*
* Builds an indexed type of vectors of ints.
*
* MPICH1 fails this test because it converts the vectors into hvectors.
*
* Returns the number of errors encountered.
*/
int indexed_of_vectors_test(void)
{
MPI_Datatype inner_vector, inner_vector_copy;
MPI_Datatype outer_indexed;
int i_count = 3, i_blocklengths[3] = { 3, 2, 1 };
int i_displacements[3] = { 10, 20, 30 };
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_vector(2,
1,
2,
MPI_INT,
&inner_vector);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
err = MPI_Type_indexed(i_count,
i_blocklengths,
i_displacements,
inner_vector,
&outer_indexed);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
/* decode outer vector (get envelope, then contents) */
err = MPI_Type_get_envelope(outer_indexed,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 7) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_INDEXED) errs++;
if (verbose) {
if (nints != 7) fprintf(stderr, "nints = %d; should be 7\n", nints);
if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes);
if (combiner != MPI_COMBINER_INDEXED)
fprintf(stderr, "combiner = %s; should be indexed\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
/* get contents of outer vector */
err = MPI_Type_get_contents(outer_indexed,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != i_count) errs++;
if (ints[1] != i_blocklengths[0]) errs++;
if (ints[2] != i_blocklengths[1]) errs++;
if (ints[3] != i_blocklengths[2]) errs++;
if (ints[4] != i_displacements[0]) errs++;
if (ints[5] != i_displacements[1]) errs++;
if (ints[6] != i_displacements[2]) errs++;
if (verbose) {
if (ints[0] != i_count)
fprintf(stderr, "count = %d; should be %d\n", ints[0], i_count);
if (ints[1] != i_blocklengths[0])
fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], i_blocklengths[0]);
if (ints[2] != i_blocklengths[1])
fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], i_blocklengths[1]);
if (ints[3] != i_blocklengths[2])
fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], i_blocklengths[2]);
if (ints[4] != i_displacements[0])
fprintf(stderr, "displacement[0] = %d; should be %d\n", ints[4], i_displacements[0]);
if (ints[5] != i_displacements[1])
fprintf(stderr, "displacement[1] = %d; should be %d\n", ints[5], i_displacements[1]);
if (ints[6] != i_displacements[2])
fprintf(stderr, "displacement[2] = %d; should be %d\n", ints[6], i_displacements[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
inner_vector_copy = types[0];
free(ints);
if (nadds) free(adds);
free(types);
/* decode inner vector */
err = MPI_Type_get_envelope(inner_vector_copy,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr,
"inner vector nints = %d; should be 3\n",
nints);
if (nadds != 0) fprintf(stderr,
"inner vector nadds = %d; should be 0\n",
nadds);
if (ntypes != 1) fprintf(stderr,
"inner vector ntypes = %d; should be 1\n",
ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "inner vector combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
err = MPI_Type_get_contents(inner_vector_copy,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 2) errs++;
if (ints[1] != 1) errs++;
if (ints[2] != 2) errs++;
if (verbose) {
if (ints[0] != 2) fprintf(stderr,
"inner vector count = %d; should be 2\n",
ints[0]);
if (ints[1] != 1) fprintf(stderr,
"inner vector blocklength = %d; should be 1\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr,
"inner vector stride = %d; should be 2\n",
ints[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &inner_vector_copy );
MPI_Type_free( &inner_vector );
MPI_Type_free( &outer_indexed );
return 0;
}
/* this used to be implemented in every file system as an fcntl. It makes
* deferred open easier if we know ADIO_Fcntl will always need a file to really
* be open. set_view doesn't modify anything related to the open files.
*/
void ADIO_Set_view(ADIO_File fd, ADIO_Offset disp, MPI_Datatype etype,
MPI_Datatype filetype, MPI_Info info, int *error_code)
{
int combiner, i, j, k, err, filetype_is_contig;
MPI_Datatype copy_etype, copy_filetype;
ADIOI_Flatlist_node *flat_file;
/* free copies of old etypes and filetypes and delete flattened
version of filetype if necessary */
MPI_Type_get_envelope(fd->etype, &i, &j, &k, &combiner);
if (combiner != MPI_COMBINER_NAMED) MPI_Type_free(&(fd->etype));
ADIOI_Datatype_iscontig(fd->filetype, &filetype_is_contig);
if (!filetype_is_contig) ADIOI_Delete_flattened(fd->filetype);
MPI_Type_get_envelope(fd->filetype, &i, &j, &k, &combiner);
if (combiner != MPI_COMBINER_NAMED) MPI_Type_free(&(fd->filetype));
/* set new info */
ADIO_SetInfo(fd, info, &err);
/* set new etypes and filetypes */
MPI_Type_get_envelope(etype, &i, &j, &k, &combiner);
if (combiner == MPI_COMBINER_NAMED) fd->etype = etype;
else {
MPI_Type_contiguous(1, etype, ©_etype);
MPI_Type_commit(©_etype);
fd->etype = copy_etype;
}
MPI_Type_get_envelope(filetype, &i, &j, &k, &combiner);
if (combiner == MPI_COMBINER_NAMED)
fd->filetype = filetype;
else {
MPI_Type_contiguous(1, filetype, ©_filetype);
MPI_Type_commit(©_filetype);
fd->filetype = copy_filetype;
ADIOI_Flatten_datatype(fd->filetype);
/* this function will not flatten the filetype if it turns out
to be all contiguous. */
}
MPI_Type_size(fd->etype, &(fd->etype_size));
fd->disp = disp;
/* reset MPI-IO file pointer to point to the first byte that can
be accessed in this view. */
ADIOI_Datatype_iscontig(fd->filetype, &filetype_is_contig);
if (filetype_is_contig) fd->fp_ind = disp;
else {
flat_file = ADIOI_Flatlist;
while (flat_file->type != fd->filetype)
flat_file = flat_file->next;
for (i=0; i<flat_file->count; i++) {
if (flat_file->blocklens[i]) {
fd->fp_ind = disp + flat_file->indices[i];
break;
}
}
}
*error_code = MPI_SUCCESS;
}
/* struct_of_basics_test(void)
*
* There's nothing simple about structs :). Although this is an easy one.
*
* Returns number of errors encountered.
*
* NOT TESTED.
*/
int struct_of_basics_test(void)
{
MPI_Datatype parent_type;
int s_count = 3, s_blocklengths[3] = { 3, 2, 1 };
MPI_Aint s_displacements[3] = { 10, 20, 30 };
MPI_Datatype s_types[3] = { MPI_CHAR, MPI_INT, MPI_FLOAT };
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_create_struct(s_count,
s_blocklengths,
s_displacements,
s_types,
&parent_type);
/* decode */
err = MPI_Type_get_envelope(parent_type,
&nints,
&nadds,
&ntypes,
&combiner);
if (nints != 4) errs++;
if (nadds != 3) errs++;
if (ntypes != 3) errs++;
if (combiner != MPI_COMBINER_STRUCT) errs++;
if (verbose) {
if (nints != 4) fprintf(stderr, "nints = %d; should be 3\n", nints);
if (nadds != 3) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 3) fprintf(stderr, "ntypes = %d; should be 3\n", ntypes);
if (combiner != MPI_COMBINER_STRUCT)
fprintf(stderr, "combiner = %s; should be struct\n",
combiner_to_string(combiner));
}
ints = malloc(nints * sizeof(*ints));
adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes *sizeof(*types));
err = MPI_Type_get_contents(parent_type,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != s_count) errs++;
if (ints[1] != s_blocklengths[0]) errs++;
if (ints[2] != s_blocklengths[1]) errs++;
if (ints[3] != s_blocklengths[2]) errs++;
if (adds[0] != s_displacements[0]) errs++;
if (adds[1] != s_displacements[1]) errs++;
if (adds[2] != s_displacements[2]) errs++;
if (types[0] != s_types[0]) errs++;
if (types[1] != s_types[1]) errs++;
if (types[2] != s_types[2]) errs++;
if (verbose) {
if (ints[0] != s_count)
fprintf(stderr, "count = %d; should be %d\n", ints[0], s_count);
if (ints[1] != s_blocklengths[0])
fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], s_blocklengths[0]);
if (ints[2] != s_blocklengths[1])
fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], s_blocklengths[1]);
if (ints[3] != s_blocklengths[2])
fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], s_blocklengths[2]);
if (adds[0] != s_displacements[0])
fprintf(stderr, "displacement[0] = %d; should be %d\n", adds[0], s_displacements[0]);
if (adds[1] != s_displacements[1])
fprintf(stderr, "displacement[1] = %d; should be %d\n", adds[1], s_displacements[1]);
if (adds[2] != s_displacements[2])
fprintf(stderr, "displacement[2] = %d; should be %d\n", adds[2], s_displacements[2]);
if (types[0] != s_types[0])
fprintf(stderr, "type[0] does not match\n");
if (types[1] != s_types[1])
fprintf(stderr, "type[1] does not match\n");
if (types[2] != s_types[2])
fprintf(stderr, "type[2] does not match\n");
}
free(ints);
free(adds);
free(types);
MPI_Type_free( &parent_type );
return errs;
}
int main(int argc, char **argv)
{
PetscInt ierr;
PetscSF sf;
Vec A,Aout;
PetscScalar *bufA;
PetscScalar *bufAout;
PetscMPIInt rank, size;
PetscInt nroots, nleaves;
PetscInt i;
PetscInt *ilocal;
PetscSFNode *iremote;
PetscBool test_dupped_type;
MPI_Datatype contig;
ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Only coded for one MPI process");
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,"","PetscSF type freeing options","none");CHKERRQ(ierr);
test_dupped_type = PETSC_FALSE;
ierr = PetscOptionsBool("-test_dupped_type", "Test dupped input type","",test_dupped_type,&test_dupped_type,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscSFCreate(PETSC_COMM_WORLD,&sf);CHKERRQ(ierr);
ierr = PetscSFSetFromOptions(sf);CHKERRQ(ierr);
nleaves = 1;
nroots = 1;
ierr = PetscMalloc1(nleaves,&ilocal);CHKERRQ(ierr);
for (i = 0; i<nleaves; i++) {
ilocal[i] = i;
}
ierr = PetscMalloc1(nleaves,&iremote);CHKERRQ(ierr);
iremote[0].rank = 0;
iremote[0].index = 0;
ierr = PetscSFSetGraph(sf,nroots,nleaves,ilocal,PETSC_OWN_POINTER,iremote,PETSC_OWN_POINTER);CHKERRQ(ierr);
ierr = PetscSFSetUp(sf);CHKERRQ(ierr);
ierr = PetscSFView(sf,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = VecSetSizes(A,4,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetFromOptions(A);CHKERRQ(ierr);
ierr = VecSetUp(A);CHKERRQ(ierr);
ierr = VecDuplicate(A,&Aout);CHKERRQ(ierr);
ierr = VecGetArray(A,&bufA);CHKERRQ(ierr);
for (i=0; i<4; i++) {
bufA[i] = (PetscScalar)i;
}
ierr = VecRestoreArray(A,&bufA);CHKERRQ(ierr);
ierr = VecGetArrayRead(A,(const PetscScalar**)&bufA);CHKERRQ(ierr);
ierr = VecGetArray(Aout,&bufAout);CHKERRQ(ierr);
ierr = MPI_Type_contiguous(4, MPIU_SCALAR, &contig);CHKERRQ(ierr);
ierr = MPI_Type_commit(&contig);CHKERRQ(ierr);
if (test_dupped_type) {
MPI_Datatype tmp;
ierr = MPI_Type_dup(contig, &tmp);CHKERRQ(ierr);
ierr = MPI_Type_free(&contig);CHKERRQ(ierr);
contig = tmp;
}
for (i=0;i<10000;i++) {
ierr = PetscSFBcastBegin(sf,contig,bufA,bufAout);CHKERRQ(ierr);
ierr = PetscSFBcastEnd(sf,contig,bufA,bufAout);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(A,(const PetscScalar**)&bufA);CHKERRQ(ierr);
ierr = VecRestoreArray(Aout,&bufAout);CHKERRQ(ierr);
ierr = VecView(Aout,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&Aout);CHKERRQ(ierr);
ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
ierr = MPI_Type_free(&contig);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/* hindexed_block_vector_test()
*
* Tests behavior with a hindexed_block of some vector types;
* this shouldn't be easily convertable into anything else.
*
* Returns the number of errors encountered.
*/
int hindexed_block_vector_test(void)
{
#define NELT (18)
int buf[NELT] = {
-1, -1, -1,
1, -2, 2,
-3, -3, -3,
-4, -4, -4,
3, -5, 4,
5, -6, 6
};
int expected[NELT] = {
0, 0, 0,
1, 0, 2,
0, 0, 0,
0, 0, 0,
3, 0, 4,
5, 0, 6
};
int err, errs = 0;
int i, count = 3;
MPI_Aint disp[] = { 1, 4, 5 };
MPI_Datatype vectype, newtype;
int size, int_size;
MPI_Aint extent;
/* create a vector type of 2 ints, skipping one in between */
err = MPI_Type_vector(2, 1, 2, MPI_INT, &vectype);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr, "error creating vector type in hindexed_block_contig_test()\n");
}
errs++;
}
MPI_Type_commit(&vectype);
MPI_Type_extent(vectype, &extent);
for (i = 0; i < count; i++)
disp[i] *= extent;
err = MPIX_Type_create_hindexed_block(count, 1, disp, vectype, &newtype);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr,
"error creating hindexed_block type in hindexed_block_contig_test()\n");
}
errs++;
}
MPI_Type_commit(&newtype);
err = MPI_Type_size(newtype, &size);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr, "error obtaining type size in hindexed_block_contig_test()\n");
}
errs++;
}
MPI_Type_size(MPI_INT, &int_size);
if (size != 6 * int_size) {
if (verbose) {
fprintf(stderr, "error: size != 6 * int_size in hindexed_block_contig_test()\n");
}
errs++;
}
MPI_Type_extent(newtype, &extent);
err = pack_and_unpack((char *) buf, 1, newtype, NELT * sizeof(int));
if (err != 0) {
if (verbose) {
fprintf(stderr, "error packing/unpacking in hindexed_block_vector_test()\n");
}
errs += err;
}
for (i = 0; i < NELT; i++) {
if (buf[i] != expected[i]) {
errs++;
if (verbose)
fprintf(stderr, "buf[%d] = %d; should be %d\n", i, buf[i], expected[i]);
}
}
MPI_Type_free(&vectype);
MPI_Type_free(&newtype);
return errs;
}
int TestIndexPackDouble(int n, int stride,
double *avgTimeUser, double *avgTimeMPI, double *dest, const double *src)
{
double *restrict d_dest;
const double *restrict d_src;
register int i, j;
int rep, position;
int *restrict displs = 0;
double t1, t2, t[NTRIALS];
MPI_Datatype indextype;
displs = (int *) malloc(n * sizeof(int));
for (i = 0; i < n; i++)
displs[i] = i * stride;
/* User code */
if (verbose)
printf("TestIndexPackDouble (USER): ");
for (j = 0; j < NTRIALS; j++) {
t1 = MPI_Wtime();
for (rep = 0; rep < N_REPS; rep++) {
i = n;
d_dest = dest;
d_src = src;
for (i = 0; i < n; i++) {
*d_dest++ = d_src[displs[i]];
}
}
t2 = MPI_Wtime() - t1;
t[j] = t2;
if (verbose)
printf("%.3f ", t[j]);
}
if (verbose)
printf("[%.3f]\n", noise(t, NTRIALS));
/* If there is too much noise, discard the test */
if (noise(t, NTRIALS) > VARIANCE_THRESHOLD) {
*avgTimeUser = 0;
*avgTimeMPI = 0;
if (verbose)
printf("Too much noise; discarding measurement\n");
return 0;
}
*avgTimeUser = mean(t, NTRIALS) / N_REPS;
/* MPI Index code */
MPI_Type_create_indexed_block(n, 1, displs, MPI_DOUBLE, &indextype);
MPI_Type_commit(&indextype);
free(displs);
if (verbose)
printf("TestIndexPackDouble (MPI): ");
for (j = 0; j < NTRIALS; j++) {
t1 = MPI_Wtime();
for (rep = 0; rep < N_REPS; rep++) {
position = 0;
MPI_Pack((void *) src, 1, indextype, dest, n * sizeof(double),
&position, MPI_COMM_SELF);
}
t2 = MPI_Wtime() - t1;
t[j] = t2;
if (verbose)
printf("%.3f ", t[j]);
}
if (verbose)
printf("[%.3f]\n", noise(t, NTRIALS));
/* If there is too much noise, discard the test */
if (noise(t, NTRIALS) > VARIANCE_THRESHOLD) {
*avgTimeUser = 0;
*avgTimeMPI = 0;
if (verbose)
printf("Too much noise; discarding measurement\n");
}
else {
*avgTimeMPI = mean(t, NTRIALS) / N_REPS;
}
MPI_Type_free(&indextype);
return 0;
}
/* hindexed_block_contig_test()
*
* Tests behavior with a hindexed_block that can be converted to a
* contig easily. This is specifically for coverage.
*
* Returns the number of errors encountered.
*/
int hindexed_block_contig_test(void)
{
int buf[4] = { 7, -1, -2, -3 };
int err, errs = 0;
int i, count = 1;
MPI_Aint disp = 0;
MPI_Datatype newtype;
int size, int_size;
MPI_Aint extent;
err = MPIX_Type_create_hindexed_block(count, 1, &disp, MPI_INT, &newtype);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr, "error creating struct type in hindexed_block_contig_test()\n");
}
errs++;
}
MPI_Type_size(MPI_INT, &int_size);
err = MPI_Type_size(newtype, &size);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr, "error obtaining type size in hindexed_block_contig_test()\n");
}
errs++;
}
if (size != int_size) {
if (verbose) {
fprintf(stderr, "error: size != int_size in hindexed_block_contig_test()\n");
}
errs++;
}
err = MPI_Type_extent(newtype, &extent);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr, "error obtaining type extent in hindexed_block_contig_test()\n");
}
errs++;
}
if (extent != int_size) {
if (verbose) {
fprintf(stderr, "error: extent != int_size in hindexed_block_contig_test()\n");
}
errs++;
}
MPI_Type_commit(&newtype);
err = pack_and_unpack((char *) buf, 1, newtype, 4 * sizeof(int));
if (err != 0) {
if (verbose) {
fprintf(stderr, "error packing/unpacking in hindexed_block_contig_test()\n");
}
errs += err;
}
for (i = 0; i < 4; i++) {
int goodval;
switch (i) {
case 0:
goodval = 7;
break;
default:
goodval = 0; /* pack_and_unpack() zeros before unpack */
break;
}
if (buf[i] != goodval) {
errs++;
if (verbose)
fprintf(stderr, "buf[%d] = %d; should be %d\n", i, buf[i], goodval);
}
}
MPI_Type_free(&newtype);
return errs;
}
int main(int argc, char *argv[])
{
int errs = 0;
int size, rank;
int minsize = 2, count;
MPI_Comm comm;
int *buf, *bufout;
MPI_Op op;
MPI_Datatype mattype;
int i;
MTest_Init(&argc, &argv);
MPI_Op_create(matmult, 0, &op);
/* A single rotation matrix (3x3, stored as 9 consequetive elements) */
MPI_Type_contiguous(9, MPI_INT, &mattype);
MPI_Type_commit(&mattype);
/* Sanity check: test that our routines work properly */
{
int one = 1;
buf = (int *) malloc(4 * 9 * sizeof(int));
initMat(0, 4, 0, &buf[0]);
initMat(1, 4, 0, &buf[9]);
initMat(2, 4, 0, &buf[18]);
initMat(3, 4, 0, &buf[27]);
matmult(&buf[0], &buf[9], &one, &mattype);
matmult(&buf[9], &buf[18], &one, &mattype);
matmult(&buf[18], &buf[27], &one, &mattype);
checkResult(1, &buf[27], "Sanity Check");
free(buf);
}
while (MTestGetIntracommGeneral(&comm, minsize, 1)) {
if (comm == MPI_COMM_NULL)
continue;
MPI_Comm_size(comm, &size);
MPI_Comm_rank(comm, &rank);
for (count = 1; count < size; count++) {
/* Allocate the matrices */
buf = (int *) malloc(count * 9 * sizeof(int));
if (!buf) {
MPI_Abort(MPI_COMM_WORLD, 1);
}
bufout = (int *) malloc(count * 9 * sizeof(int));
if (!bufout) {
MPI_Abort(MPI_COMM_WORLD, 1);
}
for (i = 0; i < count; i++) {
initMat(rank, size, i, &buf[i * 9]);
}
MPI_Allreduce(buf, bufout, count, mattype, op, comm);
errs += checkResult(count, bufout, "");
/* Try the same test, but using MPI_IN_PLACE */
for (i = 0; i < count; i++) {
initMat(rank, size, i, &bufout[i * 9]);
}
MPI_Allreduce(MPI_IN_PLACE, bufout, count, mattype, op, comm);
errs += checkResult(count, bufout, "IN_PLACE");
free(buf);
free(bufout);
}
MTestFreeComm(&comm);
}
MPI_Op_free(&op);
MPI_Type_free(&mattype);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
/* tests passive target RMA on 2 processes. tests the lock-single_op-unlock
optimization for less common cases:
origin datatype derived, target datatype predefined
*/
int main(int argc, char *argv[])
{
int wrank, nprocs, *srcbuf, *rmabuf, i;
int memsize;
MPI_Datatype vectype;
MPI_Win win;
int errs = 0;
MTest_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD,&nprocs);
MPI_Comm_rank(MPI_COMM_WORLD,&wrank);
if (nprocs < 2) {
printf("Run this program with 2 or more processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
memsize = 10 * 4 * nprocs;
/* Create and initialize data areas */
srcbuf = (int *)malloc( sizeof(int) * memsize );
MPI_Alloc_mem( sizeof(int) * memsize, MPI_INFO_NULL, &rmabuf );
if (!srcbuf || !rmabuf) {
printf( "Unable to allocate srcbuf and rmabuf of size %d\n", memsize );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
for (i=0; i<memsize; i++) {
rmabuf[i] = -i;
srcbuf[i] = i;
}
MPI_Win_create( rmabuf, memsize*sizeof(int), sizeof(int), MPI_INFO_NULL,
MPI_COMM_WORLD, &win );
/* Vector of 10 elements, separated by 4 */
MPI_Type_vector( 10, 1, 4, MPI_INT, &vectype );
MPI_Type_commit( &vectype );
/* Accumulate with a derived origin type and target predefined type*/
if (wrank == 0) {
MPI_Barrier( MPI_COMM_WORLD );
MPI_Win_lock( MPI_LOCK_EXCLUSIVE, 0, 0, win );
for (i=0; i<10; i++) {
if (rmabuf[i] != -i + 4*i) {
errs++;
printf( "Acc: expected rmabuf[%d] = %d but saw %d\n",
i, -i + 4*i, rmabuf[i] );
}
rmabuf[i] = -i;
}
for (i=10; i<memsize; i++) {
if (rmabuf[i] != -i) {
errs++;
printf( "Acc: expected rmabuf[%d] = %d but saw %d\n",
i, -i, rmabuf[i] );
rmabuf[i] = -i;
}
}
MPI_Win_unlock( 0, win );
}
else if (wrank == 1) {
MPI_Win_lock( MPI_LOCK_SHARED, 0, 0, win );
MPI_Accumulate( srcbuf, 1, vectype, 0, 0, 10, MPI_INT, MPI_SUM, win );
MPI_Win_unlock( 0, win );
MPI_Barrier( MPI_COMM_WORLD );
}
else {
MPI_Barrier( MPI_COMM_WORLD );
}
MPI_Barrier(MPI_COMM_WORLD);
/* Put with a derived origin type and target predefined type*/
if (wrank == 0) {
MPI_Barrier( MPI_COMM_WORLD );
MPI_Win_lock( MPI_LOCK_EXCLUSIVE, 0, 0, win );
for (i=0; i<10; i++) {
if (rmabuf[i] != 4*i) {
errs++;
printf( "Put: expected rmabuf[%d] = %d but saw %d\n",
i, 4*i, rmabuf[i] );
}
rmabuf[i] = -i;
}
for (i=10; i<memsize; i++) {
if (rmabuf[i] != -i) {
errs++;
printf( "Put: expected rmabuf[%d] = %d but saw %d\n",
i, -i, rmabuf[i] );
rmabuf[i] = -i;
}
}
MPI_Win_unlock( 0, win );
}
else if (wrank == 1) {
MPI_Win_lock( MPI_LOCK_SHARED, 0, 0, win );
MPI_Put( srcbuf, 1, vectype, 0, 0, 10, MPI_INT, win );
MPI_Win_unlock( 0, win );
MPI_Barrier( MPI_COMM_WORLD );
}
else {
MPI_Barrier( MPI_COMM_WORLD );
}
MPI_Barrier(MPI_COMM_WORLD);
/* Put with a derived origin type and target predefined type, with
a get (see the move-to-end optimization) */
if (wrank == 0) {
MPI_Barrier( MPI_COMM_WORLD );
MPI_Win_lock( MPI_LOCK_EXCLUSIVE, 0, 0, win );
for (i=0; i<10; i++) {
if (rmabuf[i] != 4*i) {
errs++;
printf( "Put: expected rmabuf[%d] = %d but saw %d\n",
i, 4*i, rmabuf[i] );
}
rmabuf[i] = -i;
}
for (i=10; i<memsize; i++) {
if (rmabuf[i] != -i) {
errs++;
printf( "Put: expected rmabuf[%d] = %d but saw %d\n",
i, -i, rmabuf[i] );
rmabuf[i] = -i;
}
}
MPI_Win_unlock( 0, win );
}
else if (wrank == 1) {
int val;
MPI_Win_lock( MPI_LOCK_SHARED, 0, 0, win );
MPI_Get( &val, 1, MPI_INT, 0, 10, 1, MPI_INT, win );
MPI_Put( srcbuf, 1, vectype, 0, 0, 10, MPI_INT, win );
MPI_Win_unlock( 0, win );
MPI_Barrier( MPI_COMM_WORLD );
if (val != -10) {
errs++;
printf( "Get: Expected -10, got %d\n", val );
}
}
else {
MPI_Barrier( MPI_COMM_WORLD );
}
MPI_Barrier(MPI_COMM_WORLD);
/* Put with a derived origin type and target predefined type, with
a get already at the end (see the move-to-end optimization) */
if (wrank == 0) {
MPI_Barrier( MPI_COMM_WORLD );
MPI_Win_lock( MPI_LOCK_EXCLUSIVE, 0, 0, win );
for (i=0; i<10; i++) {
if (rmabuf[i] != 4*i) {
errs++;
printf( "Put: expected rmabuf[%d] = %d but saw %d\n",
i, 4*i, rmabuf[i] );
}
rmabuf[i] = -i;
}
for (i=10; i<memsize; i++) {
if (rmabuf[i] != -i) {
errs++;
printf( "Put: expected rmabuf[%d] = %d but saw %d\n",
i, -i, rmabuf[i] );
rmabuf[i] = -i;
}
}
MPI_Win_unlock( 0, win );
}
else if (wrank == 1) {
int val;
MPI_Win_lock( MPI_LOCK_SHARED, 0, 0, win );
MPI_Put( srcbuf, 1, vectype, 0, 0, 10, MPI_INT, win );
MPI_Get( &val, 1, MPI_INT, 0, 10, 1, MPI_INT, win );
MPI_Win_unlock( 0, win );
MPI_Barrier( MPI_COMM_WORLD );
if (val != -10) {
errs++;
printf( "Get: Expected -10, got %d\n", val );
}
}
else {
MPI_Barrier( MPI_COMM_WORLD );
}
MPI_Win_free( &win );
MPI_Free_mem( rmabuf );
free( srcbuf );
MPI_Type_free( &vectype );
MTest_Finalize(errs);
MPI_Finalize();
return 0;
}
/* derived_resized_test()
*
* Tests behavior with resizing of a simple derived type.
*
* Returns the number of errors encountered.
*/
int derived_resized_test(void)
{
int err, errs = 0;
int count = 2;
MPI_Datatype newtype, resizedtype;
int size;
MPI_Aint extent;
err = MPI_Type_contiguous(count,
MPI_INT,
&newtype);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr,
"error creating type in derived_resized_test()\n");
}
errs++;
}
err = MPI_Type_create_resized(newtype,
(MPI_Aint) 0,
(MPI_Aint) (2*sizeof(int) + 10),
&resizedtype);
err = MPI_Type_size(resizedtype, &size);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr,
"error obtaining type size in derived_resized_test()\n");
}
errs++;
}
if (size != 2*sizeof(int)) {
if (verbose) {
fprintf(stderr,
"error: size != %d in derived_resized_test()\n", (int) (2*sizeof(int)));
}
errs++;
}
err = MPI_Type_extent(resizedtype, &extent);
if (err != MPI_SUCCESS) {
if (verbose) {
fprintf(stderr,
"error obtaining type extent in derived_resized_test()\n");
}
errs++;
}
if (extent != 2*sizeof(int) + 10) {
if (verbose) {
fprintf(stderr,
"error: invalid extent (%d) in derived_resized_test(); should be %d\n",
(int) extent,
(int) (2*sizeof(int) + 10));
}
errs++;
}
MPI_Type_free( &newtype );
MPI_Type_free( &resizedtype );
return errs;
}
void peano::applications::pic::demo::records::RegularGridStatePacked::shutdownDatatype() {
MPI_Type_free( &RegularGridStatePacked::Datatype );
}
int main(int argc, char **argv)
{
int nprocs, mpi_err, *array;
int getval, disp, errs=0;
MPI_Win win;
MPI_Datatype type;
MTest_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
if (nprocs != 1) {
printf("Run this program with 1 process\n");
MPI_Abort(MPI_COMM_WORLD,1);
}
/* 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 );
/* create an indexed datatype that points to the second integer
in an array (the first integer is skipped). */
disp = 1;
mpi_err = MPI_Type_create_indexed_block(1, 1, &disp, MPI_INT, &type);
if (mpi_err != MPI_SUCCESS) goto err_return;
mpi_err = MPI_Type_commit(&type);
if (mpi_err != MPI_SUCCESS) goto err_return;
/* allocate window of size 2 integers*/
mpi_err = MPI_Alloc_mem(2*sizeof(int), MPI_INFO_NULL, &array);
if (mpi_err != MPI_SUCCESS) goto err_return;
/* create window object */
mpi_err = MPI_Win_create(array, 2*sizeof(int), sizeof(int),
MPI_INFO_NULL, MPI_COMM_WORLD, &win);
if (mpi_err != MPI_SUCCESS) goto err_return;
/* initialize array */
array[0] = 100;
array[1] = 200;
getval = 0;
/* To improve reporting of problems about operations, we
change the error handler to errors return */
MPI_Win_set_errhandler( win, MPI_ERRORS_RETURN );
mpi_err = MPI_Win_lock(MPI_LOCK_EXCLUSIVE, 0, 0, win);
if (mpi_err != MPI_SUCCESS) goto err_return;
/* get the current value of element array[1] */
mpi_err = MPI_Get(&getval, 1, MPI_INT, 0, 0, 1, type, win);
if (mpi_err != MPI_SUCCESS) goto err_return;
mpi_err = MPI_Win_unlock(0, win);
if (mpi_err != MPI_SUCCESS) goto err_return;
/* getval should contain the value of array[1] */
if (getval != array[1]) {
errs++;
printf("getval=%d, should be %d\n", getval, array[1]);
}
MPI_Free_mem(array);
MPI_Win_free(&win);
MPI_Type_free(&type);
MTest_Finalize(errs);
MPI_Finalize();
return 0;
err_return:
printf("MPI function error returned an error\n");
MTestPrintError( mpi_err );
errs++;
MTest_Finalize(errs);
MPI_Finalize();
return 1;
}
int main(int argc, char **argv)
{
MPI_Datatype newtype;
int i, ndims, array_of_gsizes[3], array_of_distribs[3];
int order, nprocs, len, flag, err;
int array_of_dargs[3], array_of_psizes[3];
int *readbuf, *writebuf, bufcount, mynod;
char filename[1024];
MPI_File fh;
MPI_Status status;
MPI_Aint size_with_aint;
MPI_Offset size_with_offset;
MPI_Init(&argc,&argv);
MPI_Comm_rank(MPI_COMM_WORLD, &mynod);
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
/* process 0 takes the file name as a command-line argument and
broadcasts it to other processes */
if (!mynod) {
i = 1;
while ((i < argc) && strcmp("-fname", *argv)) {
i++;
argv++;
}
if (i >= argc) {
printf("\n*# Usage: large_array -fname filename\n\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
argv++;
len = strlen(*argv);
strcpy(filename, *argv);
MPI_Bcast(&len, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(filename, len+1, MPI_CHAR, 0, MPI_COMM_WORLD);
printf("This program creates a 4 Gbyte file. Don't run it if you don't have that much disk space!\n");
}
else {
MPI_Bcast(&len, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(filename, len+1, MPI_CHAR, 0, MPI_COMM_WORLD);
}
/* create the distributed array filetype */
ndims = 3;
order = MPI_ORDER_C;
array_of_gsizes[0] = 1024;
array_of_gsizes[1] = 1024;
array_of_gsizes[2] = 4*1024/sizeof(int);
array_of_distribs[0] = MPI_DISTRIBUTE_BLOCK;
array_of_distribs[1] = MPI_DISTRIBUTE_BLOCK;
array_of_distribs[2] = MPI_DISTRIBUTE_BLOCK;
array_of_dargs[0] = MPI_DISTRIBUTE_DFLT_DARG;
array_of_dargs[1] = MPI_DISTRIBUTE_DFLT_DARG;
array_of_dargs[2] = MPI_DISTRIBUTE_DFLT_DARG;
for (i=0; i<ndims; i++) array_of_psizes[i] = 0;
MPI_Dims_create(nprocs, ndims, array_of_psizes);
/* check if MPI_Aint is large enough for size of global array.
if not, complain. */
size_with_aint = sizeof(int);
for (i=0; i<ndims; i++) size_with_aint *= array_of_gsizes[i];
size_with_offset = sizeof(int);
for (i=0; i<ndims; i++) size_with_offset *= array_of_gsizes[i];
if (size_with_aint != size_with_offset) {
printf("Can't use an array of this size unless the MPI implementation defines a 64-bit MPI_Aint\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
MPI_Type_create_darray(nprocs, mynod, ndims, array_of_gsizes,
array_of_distribs, array_of_dargs,
array_of_psizes, order, MPI_INT, &newtype);
MPI_Type_commit(&newtype);
/* initialize writebuf */
MPI_Type_size(newtype, &bufcount);
bufcount = bufcount/sizeof(int);
writebuf = (int *) malloc(bufcount * sizeof(int));
if (!writebuf) printf("Process %d, not enough memory for writebuf\n", mynod);
for (i=0; i<bufcount; i++) writebuf[i] = mynod*1024 + i;
/* write the array to the file */
MPI_File_open(MPI_COMM_WORLD, filename, MPI_MODE_CREATE | MPI_MODE_RDWR,
MPI_INFO_NULL, &fh);
MPI_File_set_view(fh, 0, MPI_INT, newtype, "native", MPI_INFO_NULL);
MPI_File_write_all(fh, writebuf, bufcount, MPI_INT, &status);
MPI_File_close(&fh);
free(writebuf);
/* now read it back */
readbuf = (int *) calloc(bufcount, sizeof(int));
if (!readbuf) printf("Process %d, not enough memory for readbuf\n", mynod);
MPI_File_open(MPI_COMM_WORLD, filename, MPI_MODE_CREATE | MPI_MODE_RDWR,
MPI_INFO_NULL, &fh);
MPI_File_set_view(fh, 0, MPI_INT, newtype, "native", MPI_INFO_NULL);
MPI_File_read_all(fh, readbuf, bufcount, MPI_INT, &status);
MPI_File_close(&fh);
/* check the data read */
flag = 0;
for (i=0; i<bufcount; i++)
if (readbuf[i] != mynod*1024 + i) {
printf("Process %d, readbuf=%d, writebuf=%d\n", mynod, readbuf[i], mynod*1024 + i);
flag = 1;
}
if (!flag) printf("Process %d: data read back is correct\n", mynod);
MPI_Type_free(&newtype);
free(readbuf);
MPI_Barrier(MPI_COMM_WORLD);
if (!mynod) {
err = MPI_File_delete(filename, MPI_INFO_NULL);
if (err == MPI_SUCCESS) printf("file deleted\n");
}
MPI_Finalize();
return 0;
}
/*
This program is derived from one in the MPICH-1 test suite
This version sends and receives EVERYTHING from MPI_BOTTOM, by putting
the data into a structure.
*/
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
int *counts, *bytesize, ntype;
MPI_Comm comm;
int rank, np, partner, tag, count;
int j, k, err, world_rank, errloc;
MPI_Status status;
char *obuf;
MPI_Datatype offsettype;
int blen;
MPI_Aint displ, extent, natural_extent;
char myname[MPI_MAX_OBJECT_NAME];
int mynamelen;
MTest_Init( &argc, &argv );
MTestDatatype2Allocate( &types, &inbufs, &outbufs, &counts, &bytesize,
&ntype );
MTestDatatype2Generate( types, inbufs, outbufs, counts, bytesize, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
/* Test over a wide range of datatypes and communicators */
err = 0;
tag = 0;
while (MTestGetIntracomm( &comm, 2 )) {
if (comm == MPI_COMM_NULL) continue;
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &np );
if (np < 2) continue;
tag++;
for (j=0; j<ntype; j++) {
MPI_Type_get_name( types[j], myname, &mynamelen );
if (world_rank == 0)
MTestPrintfMsg( 10, "Testing type %s\n", myname );
if (rank == 0) {
MPI_Get_address( inbufs[j], &displ );
blen = 1;
MPI_Type_create_struct( 1, &blen, &displ, types + j,
&offsettype );
MPI_Type_commit( &offsettype );
/* Warning: if the type has an explicit MPI_UB, then using a
simple shift of the offset won't work. For now, we skip
types whose extents are negative; the correct solution is
to add, where required, an explicit MPI_UB */
MPI_Type_extent( offsettype, &extent );
if (extent < 0) {
if (world_rank == 0)
MTestPrintfMsg( 10,
"... skipping (appears to have explicit MPI_UB\n" );
MPI_Type_free( &offsettype );
continue;
}
MPI_Type_extent( types[j], &natural_extent );
if (natural_extent != extent) {
MPI_Type_free( &offsettype );
continue;
}
partner = np - 1;
MPI_Send( MPI_BOTTOM, counts[j], offsettype, partner, tag,
comm );
MPI_Type_free( &offsettype );
}
else if (rank == np-1) {
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Get_address( outbufs[j], &displ );
blen = 1;
MPI_Type_create_struct( 1, &blen, &displ, types + j,
&offsettype );
MPI_Type_commit( &offsettype );
/* Warning: if the type has an explicit MPI_UB, then using a
simple shift of the offset won't work. For now, we skip
types whose extents are negative; the correct solution is
to add, where required, an explicit MPI_UB */
MPI_Type_extent( offsettype, &extent );
if (extent < 0) {
MPI_Type_free( &offsettype );
continue;
}
MPI_Type_extent( types[j], &natural_extent );
if (natural_extent != extent) {
MPI_Type_free( &offsettype );
continue;
}
MPI_Recv( MPI_BOTTOM, counts[j], offsettype,
partner, tag, comm, &status );
/* Test for correctness */
MPI_Get_count( &status, types[j], &count );
if (count != counts[j]) {
fprintf( stderr,
"Error in counts (got %d expected %d) with type %s\n",
count, counts[j], myname );
err++;
}
if (status.MPI_SOURCE != partner) {
fprintf( stderr,
"Error in source (got %d expected %d) with type %s\n",
status.MPI_SOURCE, partner, myname );
err++;
}
if ((errloc = MTestDatatype2Check( inbufs[j], outbufs[j],
bytesize[j] ))) {
fprintf( stderr,
"Error in data with type %s (type %d on %d) at byte %d\n",
myname, j, world_rank, errloc - 1 );
if (err < 10) {
/* Give details on only the first 10 errors */
unsigned char *in_p = (unsigned char *)inbufs[j],
*out_p = (unsigned char *)outbufs[j];
int jj;
jj = errloc - 1;
jj &= 0xfffffffc; /* lop off a few bits */
in_p += jj;
out_p += jj;
fprintf( stderr, "%02x%02x%02x%02x should be %02x%02x%02x%02x\n",
out_p[0], out_p[1], out_p[2], out_p[3],
in_p[0], in_p[1], in_p[2], in_p[3] );
}
err++;
}
MPI_Type_free( &offsettype );
}
}
MTestFreeComm( &comm );
}
MTestDatatype2Free( types, inbufs, outbufs, counts, bytesize, ntype );
MTest_Finalize( err );
MPI_Finalize();
return MTestReturnValue( err );
}
int main(int argc, char** argv) {
MPI_Init(&argc, &argv);
int rank, peer, commsize;
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &commsize);
if (rank % 2) peer = rank - 1 % commsize;
else peer = rank + 1 % commsize;
if (commsize % 2 != 0) {
fprintf(stderr, "Use even number of processes.\n");
exit(EXIT_FAILURE);
}
char* mpi_inbuf;
char* mpi_outbuf;
char* pmpi_inbuf;
char* pmpi_outbuf;
test_start("isend/irecv + test (2, vector[[int], count=2, blklen=3, stride=5])");
init_buffers(20*sizeof(int), &mpi_inbuf, &pmpi_inbuf, &mpi_outbuf, &pmpi_outbuf);
MPI_Datatype vector_ddt;
MPI_Type_vector(2, 3, 5, MPI_INT, &vector_ddt);
MPI_Type_commit(&vector_ddt);
MPI_Datatype pmpi_vector_ddt;
PMPI_Type_vector(2, 3, 5, MPI_INT, &pmpi_vector_ddt);
PMPI_Type_commit(&pmpi_vector_ddt);
MPI_Request requests_mpi[2];
MPI_Request requests_pmpi[2];
MPI_Status statuses_mpi[2];
MPI_Status statuses_pmpi[2];
if (rank % 2 == 0) {
MPI_Isend(mpi_inbuf, 2, vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_mpi[0]));
MPI_Irecv(mpi_outbuf, 2, vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_mpi[1]));
PMPI_Isend(pmpi_inbuf, 2, pmpi_vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_pmpi[0]));
PMPI_Irecv(pmpi_outbuf, 2, pmpi_vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_pmpi[1]));
}
else {
MPI_Irecv(mpi_outbuf, 2, vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_mpi[0]));
MPI_Isend(mpi_inbuf, 2, vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_mpi[1]));
PMPI_Irecv(pmpi_outbuf, 2, pmpi_vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_pmpi[0]));
PMPI_Isend(pmpi_inbuf, 2, pmpi_vector_ddt, peer, 0, MPI_COMM_WORLD, &(requests_pmpi[1]));
}
int flag;
flag = 0;
while (flag == 0) MPI_Test(&(requests_mpi[0]), &flag, &(statuses_mpi[0]));
flag = 0;
while (flag == 0) MPI_Test(&(requests_mpi[1]), &flag, &(statuses_mpi[1]));
flag = 0;
while (flag == 0) MPI_Test(&(requests_pmpi[0]), &flag, &(statuses_pmpi[0]));
flag = 0;
while (flag == 0) MPI_Test(&(requests_pmpi[1]), &flag, &(statuses_pmpi[1]));
int res = compare_buffers(20*sizeof(int), &mpi_inbuf, &pmpi_inbuf, &mpi_outbuf, &pmpi_outbuf);
free_buffers(&mpi_inbuf, &pmpi_inbuf, &mpi_outbuf, &pmpi_outbuf);
test_result(res);
MPI_Type_free(&vector_ddt);
PMPI_Type_free(&pmpi_vector_ddt);
MPI_Finalize();
}
