void setup_globals() {
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
#ifdef SIZE_MUST_BE_A_POWER_OF_TWO
if (/* Check for power of 2 */ (size & (size - 1)) != 0) {
fprintf(stderr, "Number of processes %d is not a power of two, yet SIZE_MUST_BE_A_POWER_OF_TWO is defined in main.cpp.\n", size);
MPI_Abort(MPI_COMM_WORLD, 1);
}
for (lgsize = 0; lgsize < size; ++lgsize) {
if ((1 << lgsize) == size) break;
}
assert (lgsize < size);
#endif
int blocklengths[] = {1, 1, 1};
MPI_Aint displs[] = {0, 0, 0};
packed_edge temp;
MPI_Aint temp_addr, fld_addr;
MPI_Get_address(&temp, &temp_addr);
#ifdef GENERATOR_USE_PACKED_EDGE_TYPE
MPI_Get_address(&temp.v0_low, &fld_addr); displs[0] = fld_addr - temp_addr;
MPI_Get_address(&temp.v1_low, &fld_addr); displs[1] = fld_addr - temp_addr;
MPI_Get_address(&temp.high, &fld_addr); displs[2] = fld_addr - temp_addr;
MPI_Type_create_hindexed(3, blocklengths, displs, MPI_UINT32_T, &packed_edge_mpi_type);
#else
MPI_Get_address(&temp.v0, &fld_addr); displs[0] = fld_addr - temp_addr;
MPI_Get_address(&temp.v1, &fld_addr); displs[1] = fld_addr - temp_addr;
MPI_Type_create_hindexed(2, blocklengths, displs, MPI_INT64_T, &packed_edge_mpi_type);
#endif
MPI_Type_commit(&packed_edge_mpi_type);
}
static MPI_Datatype make_largexfer_type_hindexed(MPI_Offset nbytes)
{
int i, count;
int chunk_size = 1024*1024;
int *blocklens;
MPI_Aint *disp;
MPI_Datatype memtype;
/* need to cook up a new datatype to accomodate large datatypes */
/* Does require 8 byte MPI_Aint, which should have been checked for earlier
*/
if (sizeof(MPI_Aint) <= sizeof(int)) {
return MPI_DATATYPE_NULL;
}
/* ceiling division */
count = 1 + ((nbytes -1) / chunk_size );
blocklens = calloc(count, sizeof(int));
disp = calloc(count, sizeof(MPI_Aint));
for (i=0; i<(count-1); i++) {
blocklens[i] = chunk_size;
disp[i] = (MPI_Aint)chunk_size*i;
}
blocklens[count-1] = nbytes-((MPI_Aint)chunk_size*i);
disp[count-1] = (MPI_Aint)chunk_size*(count-1);
MPI_Type_create_hindexed(count, blocklens, disp, MPI_BYTE, &memtype);
MPI_Type_commit(&memtype);
return memtype;
}
JNIEXPORT jlong JNICALL Java_mpi_Datatype_getHIndexed(
JNIEnv *env, jclass clazz, jintArray blockLengths,
jintArray disps, jlong oldType)
{
MPI_Datatype type;
int count = (*env)->GetArrayLength(env, blockLengths);
jint *jBlockLengths;
int *cBlockLengths;
ompi_java_getIntArray(env, blockLengths, &jBlockLengths, &cBlockLengths);
jint *jDisps = (*env)->GetIntArrayElements(env, disps, NULL);
MPI_Aint *cDisps = (MPI_Aint*)calloc(count, sizeof(MPI_Aint));
int i;
for(i = 0; i < count; i++)
cDisps[i] = jDisps[i];
int rc = MPI_Type_create_hindexed(count, cBlockLengths, cDisps,
(MPI_Datatype)oldType, &type);
ompi_java_exceptionCheck(env, rc);
free(cDisps);
ompi_java_forgetIntArray(env, blockLengths, jBlockLengths, cBlockLengths);
(*env)->ReleaseIntArrayElements(env, disps, jDisps, JNI_ABORT);
return (jlong)type;
}
//-----------------------------------------------------------------------
//
// makes an MPI datatype for a payloads-send message
//
// cts: pointer to counts message
// pts: pointer to payloads message
// itype: datatype of a single item
//
// side effects: allocates MPI datatype
// commits MPI datatype
//
// returns: pointer to MPI datatype
//
//
MPI_Datatype* Neighborhoods::SendMsgDtype(int *cts, char **pts,
MPI_Datatype *itype) {
int nps = 0; // number of items being sent
for (int i = 0; i < cts[0]; i++)
nps += cts[i * 2 + 2];
// lengths and displacements array
int *lengths = new int[nps];
MPI_Aint *disps = new MPI_Aint[nps];
for (int i = 0; i < nps; i++) {
lengths[i] = 1;
MPI_Get_address((void *)pts[i], &disps[i]);
}
MPI_Datatype *mtype = new MPI_Datatype; // datatype for entire message
MPI_Type_create_hindexed(nps, lengths, disps, *itype, mtype);
MPI_Type_commit(mtype);
delete[] lengths;
delete[] disps;
return mtype;
}
/*
* Setup hindexed type info and handlers.
*
* A hindexed datatype is created by using following parameters.
* nblock: Number of blocks.
* blocklen: Number of elements in each block. Each block has the same length.
* stride: Strided number of elements between two adjacent blocks. The byte
* displacement of each block is set as (index of current block * stride * size of oldtype).
* lb: Lower bound of the new datatype.
* oldtype: Datatype of element.
*/
static inline int MTestTypeHindexedCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride,
MPI_Aint lb, MPI_Datatype oldtype,
const char *typename_prefix, MTestDatatype * mtype)
{
int merr;
char type_name[128];
int i;
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->index = (int *) malloc(nblock * sizeof(int));
mtype->displ_in_bytes = (MPI_Aint *) malloc(nblock * sizeof(MPI_Aint));
if (!mtype->displ_in_bytes || !mtype->index) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
mtype->nblock = nblock;
for (i = 0; i < nblock; i++) {
mtype->index[i] = blocklen;
mtype->displ_in_bytes[i] = (lb + stride * i) * mtype->basesize;
}
/* Hindexed uses displacement in bytes */
merr = MPI_Type_create_hindexed(nblock, mtype->index, mtype->displ_in_bytes,
oldtype, &mtype->datatype);
if (merr)
MTestPrintError(merr);
merr = MPI_Type_commit(&mtype->datatype);
if (merr)
MTestPrintError(merr);
memset(type_name, 0, sizeof(type_name));
sprintf(type_name, "%s %s (%ld nblock %ld blocklen %ld stride %ld lb)", typename_prefix,
"hindex", nblock, blocklen, stride, lb);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
/* Reuse indexed functions, because all of them only use displ_in_bytes */
mtype->InitBuf = MTestTypeIndexedInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeIndexedCheckbuf;
return merr;
}
int ADIOI_Type_create_hindexed_x(int count,
const MPI_Count array_of_blocklengths[],
const MPI_Aint array_of_displacements[],
MPI_Datatype oldtype,
MPI_Datatype *newtype)
{
int i, ret;
MPI_Datatype *types;
int *blocklens;
int is_big=0;
types = ADIOI_Malloc(count*sizeof(MPI_Datatype));
blocklens = ADIOI_Malloc(count*sizeof(int));
/* squashing two loops into one.
* - Look in the array_of_blocklengths for any large values
* - convert MPI_Count items (if they are not too big) into int-sized items
* after this loop we will know if we can use MPI_type_hindexed or if we
* need a more complicated BigMPI-style struct-of-chunks.
*
* Why not use the struct-of-chunks in all cases? HDF5 reported a bug,
* which I have not yet precicesly nailed down, but appears to have
* something to do with struct-of-chunks when the chunks are small */
for(i=0; i<count; i++) {
if (array_of_blocklengths[i] > INT_MAX) {
blocklens[i] = 1;
is_big=1;
type_create_contiguous_x(array_of_blocklengths[i], oldtype, &(types[i]));
} else {
/* OK to cast: checked for "bigness" above */
blocklens[i] = (int)array_of_blocklengths[i];
MPI_Type_contiguous(blocklens[i], oldtype, &(types[i]));
}
}
if (is_big) {
ret = MPI_Type_create_struct(count, blocklens, array_of_displacements,
types, newtype);
} else {
ret = MPI_Type_create_hindexed(count, blocklens,
array_of_displacements, oldtype, newtype);
}
for (i=0; i< count; i++)
MPI_Type_free(&(types[i]));
ADIOI_Free(types);
ADIOI_Free(blocklens);
return ret;
}
void mpi_type_create_hindexed_f(MPI_Fint *count,
MPI_Fint *array_of_blocklengths,
MPI_Aint *array_of_displacements,
MPI_Fint *oldtype, MPI_Fint *newtype,
MPI_Fint *ierr)
{
MPI_Datatype c_old = MPI_Type_f2c(*oldtype);
MPI_Datatype c_new = MPI_Type_f2c(*newtype);
OMPI_ARRAY_NAME_DECL(array_of_blocklengths);
OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count);
*ierr = OMPI_INT_2_FINT(MPI_Type_create_hindexed(OMPI_FINT_2_INT(*count),
OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths),
array_of_displacements, c_old,
&c_new));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*newtype = MPI_Type_c2f(c_new);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths);
}
int main(int argc, char** argv) {
char* mpi_inbuf;
char* mpi_outbuf;
char* farc_inbuf;
char* farc_outbuf;
MPI_Init(&argc, &argv);
test_start("unpack(2, hindexed[{(1*MPI_INT, offset=4), (3*MPI_INT, offset=16), (2*MPI_INT, offset=32)}])");
init_buffers(20*sizeof(int), &mpi_inbuf, &farc_inbuf, &mpi_outbuf, &farc_outbuf);
MPI_Datatype mpitype;
int blocklen[3] = {1, 3, 2};
MPI_Aint disp[3] = {4, 16, 32};
MPI_Type_create_hindexed(3, blocklen, disp, MPI_INT, &mpitype);
MPI_Type_commit(&mpitype);
farc::DDT_Init();
farc::Datatype* t1 = new farc::PrimitiveDatatype(farc::PrimitiveDatatype::INT);
farc::Datatype* t2 = new farc::HIndexedDatatype(3, blocklen, disp, t1);
farc::DDT_Commit(t2);
farc::DDT_Unpack(farc_inbuf, farc_outbuf, t2, 2);
int position = 0;
MPI_Unpack(mpi_inbuf, 20*sizeof(int), &position, mpi_outbuf, 2, mpitype, MPI_COMM_WORLD);
int res = compare_buffers(20*sizeof(int), &mpi_inbuf, &farc_inbuf, &mpi_outbuf, &farc_outbuf);
free_buffers(&mpi_inbuf, &farc_inbuf, &mpi_outbuf, &farc_outbuf);
test_result(res);
MPI_Finalize();
return 0;
}
int MPI_Type_hindexed(int count,
int array_of_blocklengths[],
MPI_Aint array_of_displacements[],
MPI_Datatype oldtype,
MPI_Datatype *newtype)
{
int i;
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype ||
NULL == newtype) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_TYPE,
FUNC_NAME );
} else if (count < 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COUNT,
FUNC_NAME );
} else if (NULL == array_of_blocklengths ||
NULL == array_of_displacements) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME );
}
for (i = 0; i < count; ++i) {
if (array_of_blocklengths[i] < 0) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME );
}
}
}
return MPI_Type_create_hindexed(count,
array_of_blocklengths,
array_of_displacements,
oldtype,
newtype);
}
/*----< main() >------------------------------------------------------------*/
int main(int argc, char **argv)
{
int i, j, err, rank, np, num_io;
char *buf, *filename;
int rank_dim[2], array_of_sizes[2];
int array_of_subsizes[2];
int count, *blocklengths, global_array_size;
MPI_Count ftype_size;
MPI_Aint *displacements;
MPI_File fh;
MPI_Datatype ftype;
MPI_Request *request;
MPI_Status *statuses;
MPI_Status status;
MPI_Offset offset = 0;
int nr_errors = 0;
#ifdef VERBOSE
int k;
#endif
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &np);
if (np != 4) {
if (!rank)
printf("Please run with 4 processes. Exiting ...\n\n");
MPI_Finalize();
return 1;
}
filename = (argc > 1) ? argv[1] : "testfile";
num_io = 2;
request = (MPI_Request *) malloc(num_io * sizeof(MPI_Request));
statuses = (MPI_Status *) malloc(num_io * sizeof(MPI_Status));
/*-----------------------------------------------------------------------*/
/* process rank in each dimension */
rank_dim[0] = rank / 2;
rank_dim[1] = rank % 2;
/* global 2D array size */
array_of_sizes[0] = YLEN * 2;
array_of_sizes[1] = XLEN * 2;
global_array_size = array_of_sizes[0] * array_of_sizes[1];
array_of_subsizes[0] = YLEN / 2;
array_of_subsizes[1] = XLEN * SUB_XLEN / 5;
offset = rank_dim[0] * YLEN * array_of_sizes[1] + rank_dim[1] * XLEN;
/* define data type for file view */
count = array_of_subsizes[0] * 2; /* 2 is the no. blocks along X */
blocklengths = (int *) malloc(count * sizeof(int));
displacements = (MPI_Aint *) malloc(count * sizeof(MPI_Aint));
for (i = 0; i < count; i++)
blocklengths[i] = array_of_subsizes[1] / 2;
for (i = 0; i < array_of_subsizes[0]; i++)
for (j = 0; j < 2; j++)
displacements[i * 2 + j] = offset + i * 2 * array_of_sizes[1]
+ j * XLEN / 2;
MPI_Type_create_hindexed(count, blocklengths, displacements, MPI_CHAR, &ftype);
MPI_Type_commit(&ftype);
MPI_Type_size_x(ftype, &ftype_size);
/* subarray's layout in the global array
P0's 's layout P1's layout
[ 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9] | [ 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9]
[ 0] 0 1 2 3 4 5 | D E F G H I
[ 1] |
[ 2] 6 7 8 9 : ; | J K L M N O
[ 3] |
[ 4] |
[ 5] |
[ 6] |
[ 7] |
[ 8] |
[ 9] |
P2's 's layout P3's layout
[ 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9] | [ 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9]
[ 0] |
[ 1] |
[ 2] |
[ 3] |
[ 4] |
[ 5] X Y Z [ \ ] | l m n o p q
[ 6] |
[ 7] ^ _ ` a b c | r s t u v w
[ 8] |
[ 9] |
*/
/* initialize the write buffer */
buf = (char *) malloc(array_of_subsizes[0] * array_of_subsizes[1]);
for (i = 0; i < array_of_subsizes[0] * array_of_subsizes[1]; i++)
buf[i] = '0' + rank * 20 + i % 79;
/* zero file contents --------------------------------------------------- */
if (rank == 0) {
char *wr_buf = (char *) calloc(num_io * global_array_size, 1);
MPI_File_open(MPI_COMM_SELF, filename,
MPI_MODE_CREATE | MPI_MODE_WRONLY, MPI_INFO_NULL, &fh);
MPI_File_write(fh, wr_buf, num_io * global_array_size, MPI_CHAR, &status);
MPI_File_close(&fh);
free(wr_buf);
}
/* open the file -------------------------------------------------------- */
err = MPI_File_open(MPI_COMM_WORLD, filename,
MPI_MODE_CREATE | MPI_MODE_WRONLY, MPI_INFO_NULL, &fh);
if (err != MPI_SUCCESS) {
printf("Error: MPI_File_open() filename %s\n", filename);
MPI_Abort(MPI_COMM_WORLD, -1);
exit(1);
}
/* MPI nonblocking collective write */
for (i = 0; i < num_io; i++) {
offset = i * global_array_size;
/* set the file view */
MPI_File_set_view(fh, offset, MPI_BYTE, ftype, "native", MPI_INFO_NULL);
MPI_File_iwrite_all(fh, buf, ftype_size, MPI_CHAR, &request[i]);
}
MPI_Waitall(num_io, request, statuses);
MPI_File_close(&fh);
/* read and print file contents ----------------------------------------- */
if (rank == 0) {
char *ptr;
char *rd_buf = (char *) calloc(num_io * global_array_size, 1);
MPI_File_open(MPI_COMM_SELF, filename, MPI_MODE_RDONLY, MPI_INFO_NULL, &fh);
MPI_File_read(fh, rd_buf, num_io * global_array_size, MPI_CHAR, &status);
MPI_File_close(&fh);
#ifdef VERBOSE
printf("-------------------------------------------------------\n");
printf(" [");
for (i = 0; i < 2; i++) {
for (j = 0; j < XLEN; j++)
printf(" %d", j);
printf(" ");
}
printf("]\n\n");
ptr = rd_buf;
for (k = 0; k < num_io; k++) {
for (i = 0; i < 2 * YLEN; i++) {
printf("[%2d]", k * 2 * YLEN + i);
for (j = 0; j < 2 * XLEN; j++) {
if (j > 0 && j % XLEN == 0)
printf(" ");
if (*ptr != 0)
printf(" %c", *ptr);
else
printf(" ");
ptr++;
}
printf("\n");
}
printf("\n");
}
#endif
ptr = rd_buf;
for (i = 0; i < 2 * YLEN * num_io; i++) {
for (j = 0; j < 2 * XLEN; j++) {
if (*ptr != compare_buf[i][j]) {
fprintf(stderr, "expected %d got %d at [%d][%d]\n",
*ptr, compare_buf[i][j], i, j);
nr_errors++;
}
ptr++;
}
}
free(rd_buf);
if (nr_errors == 0)
fprintf(stdout, " No Errors\n");
else
fprintf(stderr, "Found %d errors\n", nr_errors);
}
free(blocklengths);
free(displacements);
free(buf);
free(request);
free(statuses);
MPI_Type_free(&ftype);
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
int i, j, rank, nranks, peer, bufsize, errs;
double *win_buf, *src_buf, *dst_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);
MPI_Alloc_mem(bufsize, MPI_INFO_NULL, &dst_buf);
for (i = 0; i < XDIM * YDIM; i++) {
*(win_buf + i) = 1.0 + rank;
*(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 put operations */
for (i = 0; i < ITERATIONS; i++) {
MPI_Aint idx_loc[SUB_YDIM];
int idx_rem[SUB_YDIM];
int blk_len[SUB_YDIM];
MPI_Datatype src_type, dst_type;
for (j = 0; j < SUB_YDIM; j++) {
MPI_Get_address(&src_buf[j * XDIM], &idx_loc[j]);
idx_rem[j] = j * XDIM * sizeof(double);
blk_len[j] = SUB_XDIM * sizeof(double);
}
MPI_Type_create_hindexed(SUB_YDIM, blk_len, idx_loc, MPI_BYTE, &src_type);
MPI_Type_create_indexed_block(SUB_YDIM, SUB_XDIM * sizeof(double), idx_rem, MPI_BYTE,
&dst_type);
MPI_Type_commit(&src_type);
MPI_Type_commit(&dst_type);
MPI_Win_lock(MPI_LOCK_EXCLUSIVE, peer, 0, buf_win);
MPI_Put(MPI_BOTTOM, 1, src_type, peer, 0, 1, dst_type, 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);
errs = 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 + ((rank + nranks - 1) % nranks));
if (actual - expected > 1e-10) {
SQUELCH(printf("%d: Data validation failed at [%d, %d] expected=%f actual=%f\n",
rank, j, i, expected, actual););
errs++;
fflush(stdout);
}
}
int
main(int argc, char* argv[])
{
size_t packed_ddt_len;
const void *packed_ddt;
void *payload, *ptr;
struct ompi_datatype_t *unpacked_dt;
int ret = 0;
int blen[2];
MPI_Aint disp[2];
MPI_Datatype newType, types[2], struct_type;
MPI_Init(&argc, &argv);
/* Basic test... */
printf("---> Basic test with MPI_INT\n");
packed_ddt_len = ompi_datatype_pack_description_length(MPI_INT);
ptr = payload = malloc(packed_ddt_len);
ret = ompi_datatype_get_pack_description(MPI_INT, &packed_ddt);
if (ret != 0) goto cleanup;
memcpy(payload, packed_ddt, packed_ddt_len);
unpacked_dt = ompi_datatype_create_from_packed_description(&payload,
ompi_proc_local());
free(ptr);
if (unpacked_dt == MPI_INT) {
printf("\tPASSED\n");
} else {
printf("\tFAILED: datatypes don't match\n");
ret = 1;
goto cleanup;
}
printf("---> Advanced test with hindexed\n");
blen[0] = 10;
blen[1] = 10;
disp[0] = 0;
disp[1] = 20*sizeof(double);
ret = MPI_Type_create_hindexed(2, blen, disp, MPI_DOUBLE,
&newType);
if (ret != 0) goto cleanup;
ret = MPI_Type_commit(&newType);
if (ret != 0) goto cleanup;
packed_ddt_len = ompi_datatype_pack_description_length(newType);
ptr = payload = malloc(packed_ddt_len);
ret = ompi_datatype_get_pack_description(newType, &packed_ddt);
if (ret != 0) goto cleanup;
memcpy(payload, packed_ddt, packed_ddt_len);
unpacked_dt = ompi_datatype_create_from_packed_description(&payload,
ompi_proc_local());
free(ptr);
if (unpacked_dt != NULL) {
printf("\tPASSED\n");
} else {
printf("\tFAILED: datatypes don't match\n");
ret = 1;
goto cleanup;
}
printf("---> Even more advanced test using the previous type and struct\n");
blen[0] = 11;
blen[1] = 2;
disp[0] = 0;
disp[1] = 64;
types[0] = MPI_INT;
types[1] = newType;
MPI_Type_create_struct( 2, blen, disp, types, &struct_type );
if (ret != 0) goto cleanup;
ret = MPI_Type_commit(&struct_type);
if (ret != 0) goto cleanup;
packed_ddt_len = ompi_datatype_pack_description_length(struct_type);
ptr = payload = malloc(packed_ddt_len);
ret = ompi_datatype_get_pack_description(struct_type, &packed_ddt);
if (ret != 0) goto cleanup;
memcpy(payload, packed_ddt, packed_ddt_len);
unpacked_dt = ompi_datatype_create_from_packed_description(&payload,
ompi_proc_local());
free(ptr);
if (unpacked_dt != NULL) {
printf("\tPASSED\n");
} else {
printf("\tFAILED: datatypes don't match\n");
ret = 1;
goto cleanup;
}
cleanup:
MPI_Finalize();
return ret;
}
FORT_DLL_SPEC void FORT_CALL mpi_type_create_hindexed_ ( MPI_Fint *v1, MPI_Fint v2[], MPI_Aint * v3, MPI_Fint *v4, MPI_Fint *v5, MPI_Fint *ierr ){
*ierr = MPI_Type_create_hindexed( (int)*v1, v2, v3, (MPI_Datatype)(*v4), (MPI_Datatype *)(v5) );
}
/*----< main() >------------------------------------------------------------*/
int main(int argc, char **argv) {
char filename[256];
int i, j, err, ncid, varid0, varid1, varid2, dimids[2], nerrs=0;
int rank, nprocs, debug=0, blocklengths[2], **buf, *bufptr;
int array_of_sizes[2], array_of_subsizes[2], array_of_starts[2];
MPI_Offset start[2], count[2];
MPI_Aint a0, a1, disps[2];
MPI_Datatype buftype, ghost_buftype, rec_filetype, fix_filetype;
MPI_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
if (argc > 2) {
if (!rank) printf("Usage: %s [filename]\n",argv[0]);
MPI_Finalize();
return 0;
}
strcpy(filename, "testfile.nc");
if (argc == 2) strcpy(filename, argv[1]);
MPI_Bcast(filename, 256, MPI_CHAR, 0, MPI_COMM_WORLD);
if (rank == 0) {
char cmd_str[256];
sprintf(cmd_str, "*** TESTING C %s for flexible put and get ", argv[0]);
printf("%-66s ------ ", cmd_str); fflush(stdout);
}
buf = (int**)malloc(NY * sizeof(int*));
buf[0] = (int*)malloc(NY * NX * sizeof(int));
for (i=1; i<NY; i++) buf[i] = buf[i-1] + NX;
/* construct various MPI derived data types */
/* construct an MPI derived data type for swapping 1st row with 2nd row */
blocklengths[0] = blocklengths[1] = NX;
MPI_Get_address(buf[1], &a0);
MPI_Get_address(buf[0], &a1);
disps[0] = 0;
disps[1] = a1 - a0;
bufptr = buf[1];
err = MPI_Type_create_hindexed(2, blocklengths, disps, MPI_INT, &buftype);
if (err != MPI_SUCCESS) printf("MPI error MPI_Type_create_hindexed\n");
MPI_Type_commit(&buftype);
start[0] = 0; start[1] = NX*rank;
count[0] = 2; count[1] = NX;
if (debug) printf("put start=%lld %lld count=%lld %lld\n",start[0],start[1],count[0],count[1]);
/* create a file type for the fixed-size variable */
array_of_sizes[0] = 2;
array_of_sizes[1] = NX*nprocs;
array_of_subsizes[0] = count[0];
array_of_subsizes[1] = count[1];
array_of_starts[0] = start[0];
array_of_starts[1] = start[1];
MPI_Type_create_subarray(2, array_of_sizes, array_of_subsizes,
array_of_starts, MPI_ORDER_C,
MPI_INT, &fix_filetype);
MPI_Type_commit(&fix_filetype);
/* create a buftype with ghost cells on each side */
array_of_sizes[0] = count[0]+4;
array_of_sizes[1] = count[1]+4;
array_of_subsizes[0] = count[0];
array_of_subsizes[1] = count[1];
array_of_starts[0] = 2;
array_of_starts[1] = 2;
MPI_Type_create_subarray(2, array_of_sizes, array_of_subsizes,
array_of_starts, MPI_ORDER_C,
MPI_INT, &ghost_buftype);
MPI_Type_commit(&ghost_buftype);
/* create a new file for write */
err = ncmpi_create(MPI_COMM_WORLD, filename, NC_CLOBBER, MPI_INFO_NULL,
&ncid); ERR
/* define a 2D array */
err = ncmpi_def_dim(ncid, "REC_DIM", NC_UNLIMITED, &dimids[0]); ERR
err = ncmpi_def_dim(ncid, "X", NX*nprocs, &dimids[1]); ERR
err = ncmpi_def_var(ncid, "rec_var", NC_INT, 2, dimids, &varid0); ERR
err = ncmpi_def_var(ncid, "dummy_rec", NC_INT, 2, dimids, &varid2); ERR
err = ncmpi_def_dim(ncid, "FIX_DIM", 2, &dimids[0]); ERR
err = ncmpi_def_var(ncid, "fix_var", NC_INT, 2, dimids, &varid1); ERR
err = ncmpi_enddef(ncid); ERR
/* create a file type for the record variable */
int *array_of_blocklengths=(int*) malloc(count[0]*sizeof(int));
MPI_Aint *array_of_displacements=(MPI_Aint*) malloc(count[0]*sizeof(MPI_Aint));
MPI_Offset recsize;
err = ncmpi_inq_recsize(ncid, &recsize);
for (i=0; i<count[0]; i++) {
array_of_blocklengths[i] = count[1];
array_of_displacements[i] = start[1]*sizeof(int) + recsize * i;
}
MPI_Type_create_hindexed(2, array_of_blocklengths, array_of_displacements,
MPI_INT, &rec_filetype);
MPI_Type_commit(&rec_filetype);
free(array_of_blocklengths);
free(array_of_displacements);
/* initialize the contents of the array */
for (j=0; j<NY; j++) for (i=0; i<NX; i++) buf[j][i] = rank*100 + j*10 + i;
/* write the record variable */
err = ncmpi_put_vard_all(ncid, varid0, rec_filetype, bufptr, 1, buftype); ERR
/* check if the contents of buf are altered */
CHECK_VALUE
/* check if root process can write to file header in data mode */
err = ncmpi_rename_var(ncid, varid0, "rec_VAR"); ERR
/* write the fixed-size variable */
err = ncmpi_put_vard_all(ncid, varid1, fix_filetype, bufptr, 1, buftype); ERR
/* check if the contents of buf are altered */
CHECK_VALUE
/* check if root process can write to file header in data mode */
err = ncmpi_rename_var(ncid, varid0, "rec_var"); ERR
/* test the same routines in independent data mode */
err = ncmpi_begin_indep_data(ncid); ERR
err = ncmpi_put_vard(ncid, varid0, rec_filetype, bufptr, 1, buftype); ERR
CHECK_VALUE
err = ncmpi_rename_var(ncid, varid0, "rec_VAR"); ERR
err = ncmpi_put_vard(ncid, varid1, fix_filetype, bufptr, 1, buftype); ERR
CHECK_VALUE
err = ncmpi_rename_var(ncid, varid0, "rec_var"); ERR
err = ncmpi_end_indep_data(ncid); ERR
err = ncmpi_close(ncid); ERR
/* open the same file and read back for validate */
err = ncmpi_open(MPI_COMM_WORLD, filename, NC_NOWRITE, MPI_INFO_NULL,
&ncid); ERR
err = ncmpi_inq_varid(ncid, "rec_var", &varid0); ERR
err = ncmpi_inq_varid(ncid, "fix_var", &varid1); ERR
nerrs += get_var_and_verify(ncid, varid0, start, count, buf, buftype, ghost_buftype, rec_filetype);
nerrs += get_var_and_verify(ncid, varid1, start, count, buf, buftype, ghost_buftype, fix_filetype);
err = ncmpi_close(ncid); ERR
MPI_Type_free(&rec_filetype);
MPI_Type_free(&fix_filetype);
MPI_Type_free(&buftype);
MPI_Type_free(&ghost_buftype);
free(buf[0]); free(buf);
/* check if PnetCDF freed all internal malloc */
MPI_Offset malloc_size, sum_size;
err = ncmpi_inq_malloc_size(&malloc_size);
if (err == NC_NOERR) {
MPI_Reduce(&malloc_size, &sum_size, 1, MPI_OFFSET, MPI_SUM, 0, MPI_COMM_WORLD);
if (rank == 0 && sum_size > 0)
printf("heap memory allocated by PnetCDF internally has %lld bytes yet to be freed\n",
sum_size);
}
MPI_Allreduce(MPI_IN_PLACE, &nerrs, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
if (rank == 0) {
if (nerrs) printf(FAIL_STR,nerrs);
else printf(PASS_STR);
}
MPI_Finalize();
return 0;
}
/** Optimized implementation of the ARMCI IOV operation that uses an MPI
* datatype to achieve a one-sided gather/scatter. Does not use MPI_BOTTOM.
*/
int ARMCII_Iov_op_datatype_no_bottom(enum ARMCII_Op_e op, void **src, void **dst, int count, int elem_count,
MPI_Datatype type, int proc) {
gmr_t *mreg;
MPI_Datatype type_loc, type_rem;
MPI_Aint disp_loc[count];
int disp_rem[count];
int block_len[count];
void *dst_win_base;
int dst_win_size, i, type_size;
void **buf_rem, **buf_loc;
MPI_Aint base_rem;
MPI_Aint base_loc;
void *base_loc_ptr;
switch(op) {
case ARMCII_OP_ACC:
case ARMCII_OP_PUT:
buf_rem = dst;
buf_loc = src;
break;
case ARMCII_OP_GET:
buf_rem = src;
buf_loc = dst;
break;
default:
ARMCII_Error("unknown operation (%d)", op);
return 1;
}
MPI_Type_size(type, &type_size);
mreg = gmr_lookup(buf_rem[0], proc);
ARMCII_Assert_msg(mreg != NULL, "Invalid remote pointer");
dst_win_base = mreg->slices[proc].base;
dst_win_size = mreg->slices[proc].size;
MPI_Get_address(dst_win_base, &base_rem);
/* Pick a base address for the start of the origin's datatype */
base_loc_ptr = buf_loc[0];
MPI_Get_address(base_loc_ptr, &base_loc);
for (i = 0; i < count; i++) {
MPI_Aint target_rem, target_loc;
MPI_Get_address(buf_loc[i], &target_loc);
MPI_Get_address(buf_rem[i], &target_rem);
disp_loc[i] = target_loc - base_loc;
disp_rem[i] = (target_rem - base_rem)/type_size;
block_len[i] = elem_count;
ARMCII_Assert_msg((target_rem - base_rem) % type_size == 0, "Transfer size is not a multiple of type size");
ARMCII_Assert_msg(disp_rem[i] >= 0 && disp_rem[i] < dst_win_size, "Invalid remote pointer");
ARMCII_Assert_msg(((uint8_t*)buf_rem[i]) + block_len[i] <= ((uint8_t*)dst_win_base) + dst_win_size, "Transfer exceeds buffer length");
}
MPI_Type_create_hindexed(count, block_len, disp_loc, type, &type_loc);
MPI_Type_create_indexed_block(count, elem_count, disp_rem, type, &type_rem);
//MPI_Type_indexed(count, block_len, disp_rem, type, &type_rem);
MPI_Type_commit(&type_loc);
MPI_Type_commit(&type_rem);
gmr_lock(mreg, proc);
switch(op) {
case ARMCII_OP_ACC:
gmr_accumulate_typed(mreg, base_loc_ptr, 1, type_loc, MPI_BOTTOM, 1, type_rem, proc);
break;
case ARMCII_OP_PUT:
gmr_put_typed(mreg, base_loc_ptr, 1, type_loc, MPI_BOTTOM, 1, type_rem, proc);
break;
case ARMCII_OP_GET:
gmr_get_typed(mreg, MPI_BOTTOM, 1, type_rem, base_loc_ptr, 1, type_loc, proc);
break;
default:
ARMCII_Error("unknown operation (%d)", op);
return 1;
}
gmr_unlock(mreg, proc);
MPI_Type_free(&type_loc);
MPI_Type_free(&type_rem);
return 0;
}
static int test_vard(int ncid, int *varid)
{
int rank, nprocs, err, nerrs=0, i, buf[NY+4][NX+4];
int array_of_sizes[2], array_of_subsizes[2], array_of_starts[2];
MPI_Offset start[2], count[2];
MPI_Datatype buftype, rec_filetype, fix_filetype;
MPI_Comm_size(MPI_COMM_WORLD, &nprocs);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
start[0] = 0; start[1] = NX*rank;
count[0] = 2; count[1] = NX;
/* create a buftype with ghost cells on each side */
array_of_sizes[0] = count[0]+4;
array_of_sizes[1] = count[1]+4;
array_of_subsizes[0] = count[0];
array_of_subsizes[1] = count[1];
array_of_starts[0] = 2;
array_of_starts[1] = 2;
MPI_Type_create_subarray(2, array_of_sizes, array_of_subsizes,
array_of_starts, MPI_ORDER_C,
MPI_INT, &buftype);
MPI_Type_commit(&buftype);
/* create a file type for the fixed-size variable */
array_of_sizes[0] = 2;
array_of_sizes[1] = NX*nprocs;
array_of_subsizes[0] = count[0];
array_of_subsizes[1] = count[1];
array_of_starts[0] = start[0];
array_of_starts[1] = start[1];
MPI_Type_create_subarray(2, array_of_sizes, array_of_subsizes,
array_of_starts, MPI_ORDER_C,
MPI_INT, &fix_filetype);
MPI_Type_commit(&fix_filetype);
/* create a file type for the record variable */
int *array_of_blocklengths=(int*) malloc(count[0]*sizeof(int));
MPI_Aint *array_of_displacements=(MPI_Aint*) malloc(count[0]*sizeof(MPI_Aint));
MPI_Offset recsize;
err = ncmpi_inq_recsize(ncid, &recsize);
for (i=0; i<count[0]; i++) {
array_of_blocklengths[i] = count[1];
array_of_displacements[i] = start[1]*sizeof(int) + recsize * i;
}
MPI_Type_create_hindexed(2, array_of_blocklengths, array_of_displacements,
MPI_INT, &rec_filetype);
MPI_Type_commit(&rec_filetype);
free(array_of_blocklengths);
free(array_of_displacements);
TRC(ncmpi_put_vard_all)(ncid, varid[0], rec_filetype, &buf[0][0], 1, buftype); CHECK_ERR
TRC(ncmpi_rename_var)(ncid, varid[0], "rec_VAR"); CHECK_ERR
TRC(ncmpi_put_vard_all)(ncid, varid[1], fix_filetype, &buf[0][0], 1, buftype); CHECK_ERR
TRC(ncmpi_rename_var)(ncid, varid[0], "rec_var"); CHECK_ERR
TRC(ncmpi_begin_indep_data)(ncid); CHECK_ERR
TRC(ncmpi_put_vard)(ncid, varid[0], rec_filetype, &buf[0][0], 1, buftype); CHECK_ERR
TRC(ncmpi_rename_var)(ncid, varid[0], "rec_VAR"); CHECK_ERR
TRC(ncmpi_put_vard)(ncid, varid[1], fix_filetype, &buf[0][0], 1, buftype); CHECK_ERR
TRC(ncmpi_rename_var)(ncid, varid[0], "rec_var"); CHECK_ERR
TRC(ncmpi_end_indep_data)(ncid); CHECK_ERR
MPI_Type_free(&rec_filetype);
MPI_Type_free(&fix_filetype);
MPI_Type_free(&buftype);
return nerrs;
}
