void mpi_type_set_name_f(MPI_Fint *type, char *type_name, MPI_Fint *ierr,
int name_len)
{
int ret, c_err;
char *c_name;
MPI_Datatype c_type;
c_type = MPI_Type_f2c(*type);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(type_name, name_len,
&c_name))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
"MPI_TYPE_SET_NAME");
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
/* Call the C function */
*ierr = OMPI_INT_2_FINT(MPI_Type_set_name(c_type, c_name));
/* Free the C name */
free(c_name);
}
/*
* Setup contiguous type info and handlers.
*
* A contiguous datatype is created by using following parameters (stride is unused).
* nblock: Number of blocks.
* blocklen: Number of elements in each block. The total number of elements in
* this datatype is set as (nblock * blocklen).
* lb: Lower bound of the new datatype (ignored).
* oldtype: Datatype of element.
*/
static int MTestTypeContiguousCreate(MPI_Aint nblock, MPI_Aint blocklen, MPI_Aint stride,
MPI_Aint lb, MPI_Datatype oldtype, const char *typename_prefix,
MTestDatatype * mtype)
{
int merr = 0;
char type_name[128];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->nblock = nblock;
mtype->blksize = blocklen * mtype->basesize;
merr = MPI_Type_contiguous(nblock * blocklen, 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 count)", typename_prefix, "contiguous", nblock * blocklen);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeContigInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeContigCheckbuf;
return merr;
}
JNIEXPORT void JNICALL Java_mpi_Datatype_setName(
JNIEnv *env, jobject jthis, jlong handle, jstring jname)
{
const char *name = (*env)->GetStringUTFChars(env, jname, NULL);
int rc = MPI_Type_set_name((MPI_Datatype)handle, (char*)name);
ompi_java_exceptionCheck(env, rc);
(*env)->ReleaseStringUTFChars(env, jname, name);
}
/*
* Setup struct type info and handlers.
*
* A struct 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. Each block has the same oldtype.
*/
static int MTestTypeStructCreate(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->old_datatypes = (MPI_Datatype *) malloc(nblock * sizeof(MPI_Datatype));
mtype->displ_in_bytes = (MPI_Aint *) malloc(nblock * sizeof(MPI_Aint));
mtype->index = (int *) malloc(nblock * sizeof(int));
if (!mtype->displ_in_bytes || !mtype->old_datatypes) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
mtype->nblock = nblock;
mtype->blksize = blocklen * mtype->basesize;
for (i = 0; i < nblock; i++) {
mtype->displ_in_bytes[i] = (lb + stride * i) * mtype->basesize;
mtype->old_datatypes[i] = oldtype;
mtype->index[i] = blocklen;
}
/* Struct uses displacement in bytes */
merr = MPI_Type_create_struct(nblock, mtype->index, mtype->displ_in_bytes,
mtype->old_datatypes, &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,
"struct", nblock, blocklen, stride, lb);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
/* Reuse indexed functions, because they use the same displ_in_bytes and index */
mtype->InitBuf = MTestTypeIndexedInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeIndexedCheckbuf;
return merr;
}
/*
* Setup indexed-block type info and handlers.
*
* A indexed-block datatype is created by using following parameters.
* nblock: Number of blocks.
* blocklen: Number of elements in each block.
* stride: Strided number of elements between two adjacent blocks. The
* displacement of each block is set as (index of current block * stride).
* lb: Lower bound of the new datatype.
* oldtype: Datatype of element.
*/
static int MTestTypeIndexedBlockCreate(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->displs = (int *) malloc(nblock * sizeof(int));
mtype->displ_in_bytes = (MPI_Aint *) malloc(nblock * sizeof(MPI_Aint));
if (!mtype->displs || !mtype->displ_in_bytes) {
char errmsg[128] = { 0 };
sprintf(errmsg, "Out of memory in %s", __FUNCTION__);
MTestError(errmsg);
}
mtype->nblock = nblock;
mtype->blksize = blocklen * mtype->basesize;
for (i = 0; i < nblock; i++) {
mtype->displs[i] = lb + stride * i;
mtype->displ_in_bytes[i] = (lb + stride * i) * mtype->basesize;
}
/* Indexed-block uses displacement in oldtypes */
merr = MPI_Type_create_indexed_block(nblock, blocklen, mtype->displs,
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,
"index_block", nblock, blocklen, stride, lb);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeIndexedBlockInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeIndexedBlockCheckbuf;
return merr;
}
/*
* Setup order-Fortran subarray type info and handlers.
*
* A 2D-subarray datatype specified with order Fortran and located in the right
* bottom of the full array is created by using input parameters.
* Number of elements in the dimensions of the full array: {stride, nblock + lb}
* Number of elements in the dimensions of the subarray: {blocklen, nblock}
* Starting of the subarray in each dimension: {stride - blocklen, lb}
* order: MPI_ORDER_FORTRAN
* oldtype: oldtype
*/
static int MTestTypeSubArrayOrderFortranCreate(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];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
/* use the same row and col as that of order-c subarray for buffer
* initialization and check because we access buffer in order-c */
mtype->arr_sizes[0] = nblock + lb; /* {row, col} */
mtype->arr_sizes[1] = stride;
mtype->arr_subsizes[0] = nblock; /* {row, col} */
mtype->arr_subsizes[1] = blocklen;
mtype->arr_starts[0] = lb; /* {row, col} */
mtype->arr_starts[1] = stride - blocklen;
mtype->order = MPI_ORDER_FORTRAN;
/* reverse row and col when create datatype so that we can get the same
* packed data on the other side in order to reuse the contig check function */
int arr_sizes[2] = { mtype->arr_sizes[1], mtype->arr_sizes[0] };
int arr_subsizes[2] = { mtype->arr_subsizes[1], mtype->arr_subsizes[0] };
int arr_starts[2] = { mtype->arr_starts[1], mtype->arr_starts[0] };
merr = MPI_Type_create_subarray(2, arr_sizes, arr_subsizes, arr_starts,
mtype->order, 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 (full{%d,%d}, sub{%d,%d},start{%d,%d})",
typename_prefix, "subarray-f", arr_sizes[0], arr_sizes[1],
arr_subsizes[0], arr_subsizes[1], arr_starts[0], arr_starts[1]);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeSubarrayInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeSubarrayCheckbuf;
return merr;
}
/*
* Setup order-C subarray type info and handlers.
*
* A 2D-subarray datatype specified with order C and located in the right-bottom
* of the full array is created by using input parameters.
* Number of elements in the dimensions of the full array: {nblock + lb, stride}
* Number of elements in the dimensions of the subarray: {nblock, blocklen}
* Starting of the subarray in each dimension: {1, stride - blocklen}
* order: MPI_ORDER_C
* oldtype: oldtype
*/
static int MTestTypeSubArrayOrderCCreate(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];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
mtype->arr_sizes[0] = nblock + lb; /* {row, col} */
mtype->arr_sizes[1] = stride;
mtype->arr_subsizes[0] = nblock; /* {row, col} */
mtype->arr_subsizes[1] = blocklen;
mtype->arr_starts[0] = lb; /* {row, col} */
mtype->arr_starts[1] = stride - blocklen;
mtype->order = MPI_ORDER_C;
merr = MPI_Type_create_subarray(2, mtype->arr_sizes, mtype->arr_subsizes, mtype->arr_starts,
mtype->order, 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 (full{%d,%d}, sub{%d,%d},start{%d,%d})",
typename_prefix, "subarray-c", mtype->arr_sizes[0], mtype->arr_sizes[1],
mtype->arr_subsizes[0], mtype->arr_subsizes[1], mtype->arr_starts[0],
mtype->arr_starts[1]);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
mtype->InitBuf = MTestTypeSubarrayInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeSubarrayCheckbuf;
return merr;
}
int main (int argc, char** argv) {
int rank, numprocs;
int namelen;
char name[MPI_MAX_OBJECT_NAME], newname[MPI_MAX_OBJECT_NAME];
int i, errs;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &numprocs);
// 获取所有类型名字
for (i = 0; i < 3; i++) {
MPI_Type_get_name(mpi_names[i].dtype, name, &namelen);
if (strncmp(name, mpi_names[i].name, MPI_MAX_OBJECT_NAME)) {
errs++;
fprintf(stderr, "Expected %s but got: %s \n", mpi_names[i].name, name);
fflush(stderr);
} else {
fprintf(stdout, "Proc: %d, %s type's name: %s, namelen = %d\n",
rank, mpi_names[i].name, name, namelen);
fflush(stdout);
}
}
// 重设类型名字
sprintf_s(newname, "int_%d", rank);
name[0]=0;
MPI_Type_set_name(MPI_INT, newname);
MPI_Type_get_name(MPI_INT, name, &namelen);
if (strncmp(name, newname, MPI_MAX_OBJECT_NAME)) {
errs++;
fprintf(stderr, "\nExpected MPI_INT but got: %s \n", name);
fflush(stderr);
} else {
fprintf(stdout, "\nProc: %d, MPI_INT type's name: %s, namelen = %d\n",
rank, name, namelen);
fflush(stdout);
}
MPI_Finalize();
return 0;
}
/*
* Setup hvector type info and handlers.
*
* A hvector datatype is created by using following parameters.
* nblock: Number of blocks.
* blocklen: Number of elements in each block.
* stride: Strided number of elements between blocks.
* lb: Lower bound of the new datatype (ignored).
* oldtype: Datatype of element.
*/
static int MTestTypeHvectorCreate(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];
MTestTypeReset(mtype);
merr = MPI_Type_size(oldtype, &mtype->basesize);
if (merr)
MTestPrintError(merr);
/* These sizes are in bytes (see the VectorInit code) */
mtype->stride = stride * mtype->basesize;
mtype->blksize = blocklen * mtype->basesize;
mtype->nblock = nblock;
/* Hvector uses stride in bytes */
merr = MPI_Type_create_hvector(nblock, blocklen, mtype->stride, 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)", typename_prefix, "hvector",
nblock, blocklen, stride);
merr = MPI_Type_set_name(mtype->datatype, (char *) type_name);
if (merr)
MTestPrintError(merr);
/* User the same functions as vector, because mtype->stride is in bytes */
mtype->InitBuf = MTestTypeVectorInit;
mtype->FreeBuf = MTestTypeFree;
mtype->CheckBuf = MTestTypeVectorCheckbuf;
return merr;
}
int main( int argc, char **argv )
{
char name[MPI_MAX_OBJECT_NAME];
int namelen, i, inOptional;
int errs = 0;
MTest_Init( &argc, &argv );
/* Sample some datatypes */
/* See 8.4, "Naming Objects" in MPI-2. The default name is the same
as the datatype name */
MPI_Type_get_name( MPI_DOUBLE, name, &namelen );
if (strncmp( name, "MPI_DOUBLE", MPI_MAX_OBJECT_NAME )) {
errs++;
fprintf( stderr, "Expected MPI_DOUBLE but got :%s:\n", name );
}
MPI_Type_get_name( MPI_INT, name, &namelen );
if (strncmp( name, "MPI_INT", MPI_MAX_OBJECT_NAME )) {
errs++;
fprintf( stderr, "Expected MPI_INT but got :%s:\n", name );
}
/* Now we try them ALL */
inOptional = 0;
for (i=0; mpi_names[i].name != 0; i++) {
/* Are we in the optional types? */
if (strcmp( mpi_names[i].name, "MPI_REAL4" ) == 0)
inOptional = 1;
/* If this optional type is not supported, skip it */
if (inOptional && mpi_names[i].dtype == MPI_DATATYPE_NULL) continue;
if (mpi_names[i].dtype == MPI_DATATYPE_NULL) {
/* Report an error because all of the standard types
must be supported */
errs++;
fprintf( stderr, "MPI Datatype %s is MPI_DATATYPE_NULL\n",
mpi_names[i].name );
continue;
}
MTestPrintfMsg( 10, "Checking type %s\n", mpi_names[i].name );
name[0] = 0;
MPI_Type_get_name( mpi_names[i].dtype, name, &namelen );
if (strncmp( name, mpi_names[i].name, namelen )) {
errs++;
fprintf( stderr, "Expected %s but got %s\n",
mpi_names[i].name, name );
}
}
/* Try resetting the name */
MPI_Type_set_name( MPI_INT, (char*)"int" );
name[0] = 0;
MPI_Type_get_name( MPI_INT, name, &namelen );
if (strncmp( name, "int", MPI_MAX_OBJECT_NAME )) {
errs++;
fprintf( stderr, "Expected int but got :%s:\n", name );
}
#ifndef HAVE_MPI_INTEGER16
errs++;
fprintf( stderr, "MPI_INTEGER16 is not available\n" );
#endif
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
int main( int argc, char **argv )
{
mpi_names_t mpi_names[] = {
{ MPI_CHAR, "MPI_CHAR" },
{ MPI_SIGNED_CHAR, "MPI_SIGNED_CHAR" },
{ MPI_UNSIGNED_CHAR, "MPI_UNSIGNED_CHAR" },
{ MPI_BYTE, "MPI_BYTE" },
{ MPI_WCHAR, "MPI_WCHAR" },
{ MPI_SHORT, "MPI_SHORT" },
{ MPI_UNSIGNED_SHORT, "MPI_UNSIGNED_SHORT" },
{ MPI_INT, "MPI_INT" },
{ MPI_UNSIGNED, "MPI_UNSIGNED" },
{ MPI_LONG, "MPI_LONG" },
{ MPI_UNSIGNED_LONG, "MPI_UNSIGNED_LONG" },
{ MPI_FLOAT, "MPI_FLOAT" },
{ MPI_DOUBLE, "MPI_DOUBLE" },
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* these two types were added in MPI-2.2 */
{ MPI_AINT, "MPI_AINT" },
{ MPI_OFFSET, "MPI_OFFSET" },
#endif
{ MPI_PACKED, "MPI_PACKED" },
{ MPI_LB, "MPI_LB" },
{ MPI_UB, "MPI_UB" },
{ MPI_FLOAT_INT, "MPI_FLOAT_INT" },
{ MPI_DOUBLE_INT, "MPI_DOUBLE_INT" },
{ MPI_LONG_INT, "MPI_LONG_INT" },
{ MPI_SHORT_INT, "MPI_SHORT_INT" },
{ MPI_2INT, "MPI_2INT" },
/* Fortran */
#ifdef HAVE_FORTRAN_BINDING
{ MPI_COMPLEX, "MPI_COMPLEX" },
{ MPI_DOUBLE_COMPLEX, "MPI_DOUBLE_COMPLEX" },
{ MPI_LOGICAL, "MPI_LOGICAL" },
{ MPI_REAL, "MPI_REAL" },
{ MPI_DOUBLE_PRECISION, "MPI_DOUBLE_PRECISION" },
{ MPI_INTEGER, "MPI_INTEGER" },
{ MPI_2INTEGER, "MPI_2INTEGER" },
/* 2COMPLEX (and the 2DOUBLE_COMPLEX) were in MPI 1.0 but not later */
#ifdef HAVE_MPI_2COMPLEX
{ MPI_2COMPLEX, "MPI_2COMPLEX" },
#endif
#ifdef HAVE_MPI_2DOUBLE_COMPLEX
/* MPI_2DOUBLE_COMPLEX is an extension - it is not part of MPI 2.1 */
{ MPI_2DOUBLE_COMPLEX, "MPI_2DOUBLE_COMPLEX" },
#endif
{ MPI_2REAL, "MPI_2REAL" },
{ MPI_2DOUBLE_PRECISION, "MPI_2DOUBLE_PRECISION" },
{ MPI_CHARACTER, "MPI_CHARACTER" },
#endif
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* these C99 types were added in MPI-2.2 */
{ MPI_INT8_T, "MPI_INT8_T" },
{ MPI_INT16_T, "MPI_INT16_T" },
{ MPI_INT32_T, "MPI_INT32_T" },
{ MPI_INT64_T, "MPI_INT64_T" },
{ MPI_UINT8_T, "MPI_UINT8_T" },
{ MPI_UINT16_T, "MPI_UINT16_T" },
{ MPI_UINT32_T, "MPI_UINT32_T" },
{ MPI_UINT64_T, "MPI_UINT64_T" },
{ MPI_C_BOOL, "MPI_C_BOOL" },
{ MPI_C_FLOAT_COMPLEX, "MPI_C_FLOAT_COMPLEX" },
{ MPI_C_DOUBLE_COMPLEX, "MPI_C_DOUBLE_COMPLEX" },
{ MPI_AINT, "MPI_AINT" },
{ MPI_OFFSET, "MPI_OFFSET" },
#endif
/* Size-specific types */
/* Do not move MPI_REAL4 - this is used to indicate the very first
optional type. In addition, you must not add any required types
after this type */
/* See MPI 2.1, Section 16.2. These are required, predefined types.
If the type is not available (e.g., *only* because the Fortran
compiler does not support it), the value may be MPI_DATATYPE_NULL */
{ MPI_REAL4, "MPI_REAL4" },
{ MPI_REAL8, "MPI_REAL8" },
{ MPI_REAL16, "MPI_REAL16" },
{ MPI_COMPLEX8, "MPI_COMPLEX8" },
{ MPI_COMPLEX16, "MPI_COMPLEX16" },
{ MPI_COMPLEX32, "MPI_COMPLEX32" },
{ MPI_INTEGER1, "MPI_INTEGER1" },
{ MPI_INTEGER2, "MPI_INTEGER2" },
{ MPI_INTEGER4, "MPI_INTEGER4" },
{ MPI_INTEGER8, "MPI_INTEGER8" },
#ifdef HAVE_MPI_INTEGER16
/* MPI_INTEGER16 is not included in most of the tables in MPI 2.1,
and some implementations omit it. An error will be reported, but
this ifdef allows the test to be built and run. */
{ MPI_INTEGER16, "MPI_INTEGER16" },
#endif
/* Semi-optional types - if the compiler doesn't support long double
or long long, these might be MPI_DATATYPE_NULL */
{ MPI_LONG_DOUBLE, "MPI_LONG_DOUBLE" },
{ MPI_LONG_LONG_INT, "MPI_LONG_LONG_INT" },
{ MPI_LONG_LONG, "MPI_LONG_LONG" },
{ MPI_UNSIGNED_LONG_LONG, "MPI_UNSIGNED_LONG_LONG" },
{ MPI_LONG_DOUBLE_INT, "MPI_LONG_DOUBLE_INT" },
#if MTEST_HAVE_MIN_MPI_VERSION(2,2)
/* added in MPI-2.2 */
{ MPI_C_LONG_DOUBLE_COMPLEX, "MPI_C_LONG_DOUBLE_COMPLEX" },
{ MPI_AINT, "MPI_AINT" },
{ MPI_OFFSET, "MPI_OFFSET" },
#endif
#if MTEST_HAVE_MIN_MPI_VERSION(3,0)
/* added in MPI 3 */
{ MPI_COUNT, "MPI_COUNT" },
#endif
{ 0, (char *)0 }, /* Sentinal used to indicate the last element */
};
char name[MPI_MAX_OBJECT_NAME];
int namelen, i, inOptional;
int errs = 0;
MTest_Init( &argc, &argv );
/* Sample some datatypes */
/* See 8.4, "Naming Objects" in MPI-2. The default name is the same
as the datatype name */
MPI_Type_get_name( MPI_DOUBLE, name, &namelen );
if (strncmp( name, "MPI_DOUBLE", MPI_MAX_OBJECT_NAME )) {
errs++;
fprintf( stderr, "Expected MPI_DOUBLE but got :%s:\n", name );
}
MPI_Type_get_name( MPI_INT, name, &namelen );
if (strncmp( name, "MPI_INT", MPI_MAX_OBJECT_NAME )) {
errs++;
fprintf( stderr, "Expected MPI_INT but got :%s:\n", name );
}
/* Now we try them ALL */
inOptional = 0;
for (i=0; mpi_names[i].name != 0; i++) {
/* Are we in the optional types? */
if (strcmp( mpi_names[i].name, "MPI_REAL4" ) == 0)
inOptional = 1;
/* If this optional type is not supported, skip it */
if (inOptional && mpi_names[i].dtype == MPI_DATATYPE_NULL) continue;
if (mpi_names[i].dtype == MPI_DATATYPE_NULL) {
/* Report an error because all of the standard types
must be supported */
errs++;
fprintf( stderr, "MPI Datatype %s is MPI_DATATYPE_NULL\n",
mpi_names[i].name );
continue;
}
MTestPrintfMsg( 10, "Checking type %s\n", mpi_names[i].name );
name[0] = 0;
MPI_Type_get_name( mpi_names[i].dtype, name, &namelen );
if (strncmp( name, mpi_names[i].name, namelen )) {
errs++;
fprintf( stderr, "Expected %s but got %s\n",
mpi_names[i].name, name );
}
}
/* Try resetting the name */
MPI_Type_set_name( MPI_INT, (char*)"int" );
name[0] = 0;
MPI_Type_get_name( MPI_INT, name, &namelen );
if (strncmp( name, "int", MPI_MAX_OBJECT_NAME )) {
errs++;
fprintf( stderr, "Expected int but got :%s:\n", name );
}
#ifndef HAVE_MPI_INTEGER16
errs++;
fprintf( stderr, "MPI_INTEGER16 is not available\n" );
#endif
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
/*
Create a range of datatypes with a given count elements.
This uses a selection of types, rather than an exhaustive collection.
It allocates both send and receive types so that they can have the same
type signature (collection of basic types) but different type maps (layouts
in memory)
*/
int MTestGetDatatypes( MTestDatatype *sendtype, MTestDatatype *recvtype,
int count )
{
int merr;
int i;
sendtype->InitBuf = 0;
sendtype->FreeBuf = 0;
sendtype->CheckBuf = 0;
sendtype->datatype = 0;
sendtype->isBasic = 0;
sendtype->printErrors = 0;
recvtype->InitBuf = 0;
recvtype->FreeBuf = 0;
recvtype->CheckBuf = 0;
recvtype->datatype = 0;
recvtype->isBasic = 0;
recvtype->printErrors = 0;
sendtype->buf = 0;
recvtype->buf = 0;
/* Set the defaults for the message lengths */
sendtype->count = count;
recvtype->count = count;
/* Use datatype_index to choose a datatype to use. If at the end of the
list, return 0 */
switch (datatype_index) {
case 0:
sendtype->datatype = MPI_INT;
sendtype->isBasic = 1;
recvtype->datatype = MPI_INT;
recvtype->isBasic = 1;
break;
case 1:
sendtype->datatype = MPI_DOUBLE;
sendtype->isBasic = 1;
recvtype->datatype = MPI_DOUBLE;
recvtype->isBasic = 1;
break;
case 2:
sendtype->datatype = MPI_FLOAT_INT;
sendtype->isBasic = 1;
recvtype->datatype = MPI_FLOAT_INT;
recvtype->isBasic = 1;
break;
case 3:
merr = MPI_Type_dup( MPI_INT, &sendtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_set_name( sendtype->datatype,
(char*)"dup of MPI_INT" );
if (merr) MTestPrintError( merr );
merr = MPI_Type_dup( MPI_INT, &recvtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_set_name( recvtype->datatype,
(char*)"dup of MPI_INT" );
if (merr) MTestPrintError( merr );
/* dup'ed types are already committed if the original type
was committed (MPI-2, section 8.8) */
break;
case 4:
/* vector send type and contiguous receive type */
/* These sizes are in bytes (see the VectorInit code) */
sendtype->stride = 3 * sizeof(int);
sendtype->blksize = sizeof(int);
sendtype->nelm = recvtype->count;
merr = MPI_Type_vector( recvtype->count, 1, 3, MPI_INT,
&sendtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_commit( &sendtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_set_name( sendtype->datatype,
(char*)"int-vector" );
if (merr) MTestPrintError( merr );
sendtype->count = 1;
recvtype->datatype = MPI_INT;
recvtype->isBasic = 1;
sendtype->InitBuf = MTestTypeVectorInit;
recvtype->InitBuf = MTestTypeContigInitRecv;
sendtype->FreeBuf = MTestTypeVectorFree;
recvtype->FreeBuf = MTestTypeContigFree;
sendtype->CheckBuf = 0;
recvtype->CheckBuf = MTestTypeContigCheckbuf;
break;
case 5:
/* Indexed send using many small blocks and contig receive */
sendtype->blksize = sizeof(int);
sendtype->nelm = recvtype->count;
sendtype->basesize = sizeof(int);
sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) );
sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) );
if (!sendtype->displs || !sendtype->index) {
MTestError( "Out of memory in type init\n" );
}
/* Make the sizes larger (4 ints) to help push the total
size to over 256k in some cases, as the MPICH code as of
10/1/06 used large internal buffers for packing non-contiguous
messages */
for (i=0; i<sendtype->nelm; i++) {
sendtype->index[i] = 4;
sendtype->displs[i] = 5*i;
}
merr = MPI_Type_indexed( sendtype->nelm,
sendtype->index, sendtype->displs,
MPI_INT, &sendtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_commit( &sendtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_set_name( sendtype->datatype,
(char*)"int-indexed(4-int)" );
if (merr) MTestPrintError( merr );
sendtype->count = 1;
sendtype->InitBuf = MTestTypeIndexedInit;
sendtype->FreeBuf = MTestTypeIndexedFree;
sendtype->CheckBuf = 0;
recvtype->datatype = MPI_INT;
recvtype->isBasic = 1;
recvtype->count = count * 4;
recvtype->InitBuf = MTestTypeContigInitRecv;
recvtype->FreeBuf = MTestTypeContigFree;
recvtype->CheckBuf = MTestTypeContigCheckbuf;
break;
case 6:
/* Indexed send using 2 large blocks and contig receive */
sendtype->blksize = sizeof(int);
sendtype->nelm = 2;
sendtype->basesize = sizeof(int);
sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) );
sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) );
if (!sendtype->displs || !sendtype->index) {
MTestError( "Out of memory in type init\n" );
}
/* index -> block size */
sendtype->index[0] = (recvtype->count + 1) / 2;
sendtype->displs[0] = 0;
sendtype->index[1] = recvtype->count - sendtype->index[0];
sendtype->displs[1] = sendtype->index[0] + 1;
/* There is a deliberate gap here */
merr = MPI_Type_indexed( sendtype->nelm,
sendtype->index, sendtype->displs,
MPI_INT, &sendtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_commit( &sendtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_set_name( sendtype->datatype,
(char*)"int-indexed(2 blocks)" );
if (merr) MTestPrintError( merr );
sendtype->count = 1;
sendtype->InitBuf = MTestTypeIndexedInit;
sendtype->FreeBuf = MTestTypeIndexedFree;
sendtype->CheckBuf = 0;
recvtype->datatype = MPI_INT;
recvtype->isBasic = 1;
recvtype->count = sendtype->index[0] + sendtype->index[1];
recvtype->InitBuf = MTestTypeContigInitRecv;
recvtype->FreeBuf = MTestTypeContigFree;
recvtype->CheckBuf = MTestTypeContigCheckbuf;
break;
case 7:
/* Indexed receive using many small blocks and contig send */
recvtype->blksize = sizeof(int);
recvtype->nelm = recvtype->count;
recvtype->basesize = sizeof(int);
recvtype->displs = (int *)malloc( recvtype->nelm * sizeof(int) );
recvtype->index = (int *)malloc( recvtype->nelm * sizeof(int) );
if (!recvtype->displs || !recvtype->index) {
MTestError( "Out of memory in type recv init\n" );
}
/* Make the sizes larger (4 ints) to help push the total
size to over 256k in some cases, as the MPICH code as of
10/1/06 used large internal buffers for packing non-contiguous
messages */
/* Note that there are gaps in the indexed type */
for (i=0; i<recvtype->nelm; i++) {
recvtype->index[i] = 4;
recvtype->displs[i] = 5*i;
}
merr = MPI_Type_indexed( recvtype->nelm,
recvtype->index, recvtype->displs,
MPI_INT, &recvtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_commit( &recvtype->datatype );
if (merr) MTestPrintError( merr );
merr = MPI_Type_set_name( recvtype->datatype,
(char*)"recv-int-indexed(4-int)" );
if (merr) MTestPrintError( merr );
recvtype->count = 1;
recvtype->InitBuf = MTestTypeIndexedInitRecv;
recvtype->FreeBuf = MTestTypeIndexedFree;
recvtype->CheckBuf = MTestTypeIndexedCheckbuf;
sendtype->datatype = MPI_INT;
sendtype->isBasic = 1;
sendtype->count = count * 4;
sendtype->InitBuf = MTestTypeContigInit;
sendtype->FreeBuf = MTestTypeContigFree;
sendtype->CheckBuf = 0;
break;
/* Less commonly used but still simple types */
case 8:
sendtype->datatype = MPI_SHORT;
sendtype->isBasic = 1;
recvtype->datatype = MPI_SHORT;
recvtype->isBasic = 1;
break;
case 9:
sendtype->datatype = MPI_LONG;
sendtype->isBasic = 1;
recvtype->datatype = MPI_LONG;
recvtype->isBasic = 1;
break;
case 10:
sendtype->datatype = MPI_CHAR;
sendtype->isBasic = 1;
recvtype->datatype = MPI_CHAR;
recvtype->isBasic = 1;
break;
case 11:
sendtype->datatype = MPI_UINT64_T;
sendtype->isBasic = 1;
recvtype->datatype = MPI_UINT64_T;
recvtype->isBasic = 1;
break;
case 12:
sendtype->datatype = MPI_FLOAT;
sendtype->isBasic = 1;
recvtype->datatype = MPI_FLOAT;
recvtype->isBasic = 1;
break;
#ifndef USE_STRICT_MPI
/* MPI_BYTE may only be used with MPI_BYTE in strict MPI */
case 13:
sendtype->datatype = MPI_INT;
sendtype->isBasic = 1;
recvtype->datatype = MPI_BYTE;
recvtype->isBasic = 1;
recvtype->count *= sizeof(int);
break;
#endif
default:
datatype_index = -1;
}
if (!sendtype->InitBuf) {
sendtype->InitBuf = MTestTypeContigInit;
recvtype->InitBuf = MTestTypeContigInitRecv;
sendtype->FreeBuf = MTestTypeContigFree;
recvtype->FreeBuf = MTestTypeContigFree;
sendtype->CheckBuf = MTestTypeContigCheckbuf;
recvtype->CheckBuf = MTestTypeContigCheckbuf;
}
datatype_index++;
if (dbgflag && datatype_index > 0) {
int typesize;
fprintf( stderr, "%d: sendtype is %s\n", wrank, MTestGetDatatypeName( sendtype ) );
merr = MPI_Type_size( sendtype->datatype, &typesize );
if (merr) MTestPrintError( merr );
fprintf( stderr, "%d: sendtype size = %d\n", wrank, typesize );
fprintf( stderr, "%d: recvtype is %s\n", wrank, MTestGetDatatypeName( recvtype ) );
merr = MPI_Type_size( recvtype->datatype, &typesize );
if (merr) MTestPrintError( merr );
fprintf( stderr, "%d: recvtype size = %d\n", wrank, typesize );
fflush( stderr );
}
else if (verbose && datatype_index > 0) {
printf( "Get new datatypes: send = %s, recv = %s\n",
MTestGetDatatypeName( sendtype ),
MTestGetDatatypeName( recvtype ) );
fflush( stdout );
}
return datatype_index;
}
