static ompi_datatype_t* __ompi_datatype_create_from_args( int32_t* i, MPI_Aint* a,
ompi_datatype_t** d, int32_t type )
{
ompi_datatype_t* datatype = NULL;
switch(type){
/******************************************************************/
case MPI_COMBINER_DUP:
/* should we duplicate d[0]? */
/* ompi_datatype_set_args( datatype, 0, NULL, 0, NULL, 1, d[0], MPI_COMBINER_DUP ); */
assert(0); /* shouldn't happen */
break;
/******************************************************************/
case MPI_COMBINER_CONTIGUOUS:
ompi_datatype_create_contiguous( i[0], d[0], &datatype );
ompi_datatype_set_args( datatype, 1, (const int **) &i, 0, NULL, 1, d, MPI_COMBINER_CONTIGUOUS );
break;
/******************************************************************/
case MPI_COMBINER_VECTOR:
ompi_datatype_create_vector( i[0], i[1], i[2], d[0], &datatype );
{
const int* a_i[3] = {&i[0], &i[1], &i[2]};
ompi_datatype_set_args( datatype, 3, a_i, 0, NULL, 1, d, MPI_COMBINER_VECTOR );
}
break;
/******************************************************************/
case MPI_COMBINER_HVECTOR_INTEGER:
case MPI_COMBINER_HVECTOR:
ompi_datatype_create_hvector( i[0], i[1], a[0], d[0], &datatype );
{
const int* a_i[2] = {&i[0], &i[1]};
ompi_datatype_set_args( datatype, 2, a_i, 1, a, 1, d, MPI_COMBINER_HVECTOR );
}
break;
/******************************************************************/
case MPI_COMBINER_INDEXED: /* TO CHECK */
ompi_datatype_create_indexed( i[0], &(i[1]), &(i[1+i[0]]), d[0], &datatype );
{
const int* a_i[3] = {&i[0], &i[1], &(i[1+i[0]])};
ompi_datatype_set_args( datatype, 2 * i[0] + 1, a_i, 0, NULL, 1, d, MPI_COMBINER_INDEXED );
}
break;
/******************************************************************/
case MPI_COMBINER_HINDEXED_INTEGER:
case MPI_COMBINER_HINDEXED:
ompi_datatype_create_hindexed( i[0], &(i[1]), a, d[0], &datatype );
{
const int* a_i[2] = {&i[0], &i[1]};
ompi_datatype_set_args( datatype, i[0] + 1, a_i, i[0], a, 1, d, MPI_COMBINER_HINDEXED );
}
break;
/******************************************************************/
case MPI_COMBINER_INDEXED_BLOCK:
ompi_datatype_create_indexed_block( i[0], i[1], &(i[2]), d[0], &datatype );
{
const int* a_i[3] = {&i[0], &i[1], &i[2]};
ompi_datatype_set_args( datatype, i[0] + 2, a_i, 0, NULL, 1, d, MPI_COMBINER_INDEXED_BLOCK );
}
break;
/******************************************************************/
case MPI_COMBINER_STRUCT_INTEGER:
case MPI_COMBINER_STRUCT:
ompi_datatype_create_struct( i[0], &(i[1]), a, d, &datatype );
{
const int* a_i[2] = {&i[0], &i[1]};
ompi_datatype_set_args( datatype, i[0] + 1, a_i, i[0], a, i[0], d, MPI_COMBINER_STRUCT );
}
break;
/******************************************************************/
case MPI_COMBINER_SUBARRAY:
ompi_datatype_create_subarray( i[0], &i[1 + 0 * i[0]], &i[1 + 1 * i[0]],
&i[1 + 2 * i[0]], i[1 + 3 * i[0]],
d[0], &datatype );
{
const int* a_i[5] = {&i[0], &i[1 + 0 * i[0]], &i[1 + 1 * i[0]], &i[1 + 2 * i[0]], &i[1 + 3 * i[0]]};
ompi_datatype_set_args( datatype, 3 * i[0] + 2, a_i, 0, NULL, 1, d, MPI_COMBINER_SUBARRAY);
}
break;
/******************************************************************/
case MPI_COMBINER_DARRAY:
ompi_datatype_create_darray( i[0] /* size */, i[1] /* rank */, i[2] /* ndims */,
&i[3 + 0 * i[0]], &i[3 + 1 * i[0]],
&i[3 + 2 * i[0]], &i[3 + 3 * i[0]],
i[3 + 4 * i[0]], d[0], &datatype );
{
const int* a_i[8] = {&i[0], &i[1], &i[2], &i[3 + 0 * i[0]], &i[3 + 1 * i[0]], &i[3 + 2 * i[0]],
&i[3 + 3 * i[0]], &i[3 + 4 * i[0]]};
ompi_datatype_set_args( datatype, 4 * i[0] + 4,a_i, 0, NULL, 1, d, MPI_COMBINER_DARRAY);
}
break;
/******************************************************************/
case MPI_COMBINER_F90_REAL:
case MPI_COMBINER_F90_COMPLEX:
/*pArgs->i[0] = i[0][0];
pArgs->i[1] = i[1][0];
*/
break;
/******************************************************************/
case MPI_COMBINER_F90_INTEGER:
/*pArgs->i[0] = i[0][0];*/
break;
/******************************************************************/
case MPI_COMBINER_RESIZED:
ompi_datatype_create_resized(d[0], a[0], a[1], &datatype);
ompi_datatype_set_args( datatype, 0, NULL, 2, a, 1, d, MPI_COMBINER_RESIZED );
break;
/******************************************************************/
case MPI_COMBINER_HINDEXED_BLOCK:
ompi_datatype_create_hindexed_block( i[0], i[1], a, d[0], &datatype );
{
const int* a_i[2] = {&i[0], &i[1]};
ompi_datatype_set_args( datatype, 2 + i[0], a_i, i[0], a, 1, d, MPI_COMBINER_HINDEXED_BLOCK );
}
break;
/******************************************************************/
default:
break;
}
return datatype;
}
int MPI_Type_create_f90_integer(int r, MPI_Datatype *newtype)
{
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
/* Note: These functions accept negative integers for the p and r
* arguments. This is because for the SELECTED_INTEGER_KIND,
* negative numbers are equivalent to zero values. See section
* 13.14.95 of the Fortran 95 standard. */
}
/**
* With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx,
* page 295, line 47 we handle this nicely by caching the values in a hash table.
* However, as the value of might not always make sense, a little bit of optimization
* might be a good idea. Therefore, first we try to see if we can handle the value
* with some kind of default value, and if it's the case then we look into the
* cache.
*/
if (r > 38) *newtype = &ompi_mpi_datatype_null.dt;
#if OMPI_HAVE_F90_INTEGER16
else if (r > 18) *newtype = &ompi_mpi_long_long_int.dt;
#else
else if (r > 18) *newtype = &ompi_mpi_datatype_null.dt;
#endif /* OMPI_HAVE_F90_INTEGER16 */
#if SIZEOF_LONG > SIZEOF_INT
else if (r > 9) *newtype = &ompi_mpi_long.dt;
#else
#if SIZEOF_LONG_LONG > SIZEOF_INT
else if (r > 9) *newtype = &ompi_mpi_long_long_int.dt;
#else
else if (r > 9) *newtype = &ompi_mpi_datatype_null.dt;
#endif /* SIZEOF_LONG_LONG > SIZEOF_INT */
#endif /* SIZEOF_LONG > SIZEOF_INT */
else if (r > 4) *newtype = &ompi_mpi_int.dt;
else if (r > 2) *newtype = &ompi_mpi_short.dt;
else *newtype = &ompi_mpi_byte.dt;
if( *newtype != &ompi_mpi_datatype_null.dt ) {
ompi_datatype_t* datatype;
int* a_i[1];
int rc;
if( OPAL_SUCCESS == opal_hash_table_get_value_uint32( &ompi_mpi_f90_integer_hashtable,
r, (void**)newtype ) ) {
return MPI_SUCCESS;
}
/* Create the duplicate type corresponding to selected type, then
* set the argument to be a COMBINER with the correct value of r
* and add it to the hash table. */
if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) {
OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD,
MPI_ERR_INTERN, FUNC_NAME );
}
/* Make sure the user is not allowed to free this datatype as specified
* in the MPI standard.
*/
datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED;
/* Mark the datatype as a special F90 convenience type */
snprintf(datatype->name, MPI_MAX_OBJECT_NAME, "COMBINER %s",
(*newtype)->name);
a_i[0] = &r;
ompi_datatype_set_args( datatype, 1, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_INTEGER );
rc = opal_hash_table_set_value_uint32( &ompi_mpi_f90_integer_hashtable, r, datatype );
if (OMPI_SUCCESS != rc) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, rc, FUNC_NAME);
}
*newtype = datatype;
return MPI_SUCCESS;
}
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, FUNC_NAME);
}
int MPI_Type_create_f90_complex(int p, int r, MPI_Datatype *newtype)
{
uint64_t key;
int p_key, r_key;
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
/* Note: These functions accept negative integers for the p and r
* arguments. This is because for the SELECTED_COMPLEX_KIND,
* negative numbers are equivalent to zero values. See section
* 13.14.95 of the Fortran 95 standard. */
if ((MPI_UNDEFINED == p && MPI_UNDEFINED == r)) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, FUNC_NAME);
}
}
/* if the user does not care about p or r set them to 0 so the
* test associate with them will always succeed.
*/
p_key = p;
r_key = r;
if( MPI_UNDEFINED == p ) p_key = 0;
if( MPI_UNDEFINED == r ) r_key = 0;
/**
* With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx,
* page 295, line 47 we handle this nicely by caching the values in a hash table.
* However, as the value of might not always make sense, a little bit of optimization
* might be a good idea. Therefore, first we try to see if we can handle the value
* with some kind of default value, and if it's the case then we look into the
* cache.
*/
if ( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) || (-LDBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt;
else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) || (-DBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_ldblcplex.dt;
else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) || (-FLT_MIN_10_EXP < r) ) *newtype = &ompi_mpi_dblcplex.dt;
else *newtype = &ompi_mpi_cplex.dt;
if( *newtype != &ompi_mpi_datatype_null.dt ) {
ompi_datatype_t* datatype;
const int* a_i[2];
int rc;
key = (((uint64_t)p_key) << 32) | ((uint64_t)r_key);
if( OPAL_SUCCESS == opal_hash_table_get_value_uint64( &ompi_mpi_f90_complex_hashtable,
key, (void**)newtype ) ) {
return MPI_SUCCESS;
}
/* Create the duplicate type corresponding to selected type, then
* set the argument to be a COMBINER with the correct value of r
* and add it to the hash table. */
if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) {
OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD,
MPI_ERR_INTERN, FUNC_NAME );
}
/* Make sure the user is not allowed to free this datatype as specified
* in the MPI standard.
*/
datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED;
/* Mark the datatype as a special F90 convenience type */
// Specifically using opal_snprintf() here (instead of
// snprintf()) so that over-eager compilers do not warn us
// that we may be truncating the output. We *know* that the
// output may be truncated, and that's ok.
opal_snprintf(datatype->name, sizeof(datatype->name),
"COMBINER %s", (*newtype)->name);
a_i[0] = &p;
a_i[1] = &r;
ompi_datatype_set_args( datatype, 2, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_COMPLEX );
rc = opal_hash_table_set_value_uint64( &ompi_mpi_f90_complex_hashtable, key, datatype );
if (OMPI_SUCCESS != rc) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, rc, FUNC_NAME);
}
*newtype = datatype;
return MPI_SUCCESS;
}
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, FUNC_NAME);
}
int main(int argc, char *argv[])
{
opal_init_util(&argc, &argv);
ompi_datatype_init();
/* Simple contiguous data: MPI_INT32_T */
{
int32_t send_data[2] = {1234, 5678};
int32_t recv_data[2] = {-1, -1};
if( verbose ) {
printf("send data %08x %08x \n", send_data[0], send_data[1]);
printf("data "); dump_hex(&send_data, sizeof(int32_t) * 2); printf("\n");
}
(void)pack_unpack_datatype( send_data, &ompi_mpi_int32_t.dt, 2,
recv_data, check_contiguous, (void*)&ompi_mpi_int32_t.dt );
if( verbose ) {
printf("recv "); dump_hex(&recv_data, sizeof(int32_t) * 2); printf("\n");
printf("recv data %08x %08x \n", recv_data[0], recv_data[1]);
}
if( (send_data[0] != recv_data[0]) || (send_data[1] != recv_data[1]) ) {
printf("Error during external32 pack/unack for contiguous types (MPI_INT32_T)\n");
exit(-1);
}
}
/* Simple contiguous data: MPI_INT16_T */
{
int16_t send_data[2] = {1234, 5678};
int16_t recv_data[2] = {-1, -1};
if( verbose ) {
printf("send data %08x %08x \n", send_data[0], send_data[1]);
printf("data "); dump_hex(&send_data, sizeof(int16_t) * 2); printf("\n");
}
(void)pack_unpack_datatype( send_data, &ompi_mpi_int16_t.dt, 2,
recv_data, check_contiguous, (void*)&ompi_mpi_int16_t.dt );
if( verbose ) {
printf("recv "); dump_hex(&recv_data, sizeof(int16_t) * 2); printf("\n");
printf("recv data %08x %08x \n", recv_data[0], recv_data[1]);
}
if( (send_data[0] != recv_data[0]) || (send_data[1] != recv_data[1]) ) {
printf("Error during external32 pack/unack for contiguous types\n");
exit(-1);
}
}
/* Vector datatype */
printf("\n\nVector datatype\n\n");
{
int count=2, blocklength=1, stride=2;
int send_data[3] = {1234, 0, 5678};
int recv_data[3] = {-1, -1, -1};
ompi_datatype_t *ddt;
ompi_datatype_create_vector ( count, blocklength, stride, &ompi_mpi_int.dt, &ddt );
{
const int* a_i[3] = {&count, &blocklength, &stride};
ompi_datatype_t *type = &ompi_mpi_int.dt;
ompi_datatype_set_args( ddt, 3, a_i, 0, NULL, 1, &type, MPI_COMBINER_VECTOR );
}
ompi_datatype_commit(&ddt);
if( verbose ) {
printf("send data %08x %x08x %08x \n", send_data[0], send_data[1], send_data[2]);
printf("data "); dump_hex(&send_data, sizeof(int32_t) * 3); printf("\n");
}
(void)pack_unpack_datatype( send_data, ddt, 1, recv_data, check_vector, (void*)&ompi_mpi_int32_t.dt );
if( verbose ) {
printf("recv "); dump_hex(&recv_data, sizeof(int32_t) * 3); printf("\n");
printf("recv data %08x %08x %08x \n", recv_data[0], recv_data[1], recv_data[2]);
}
ompi_datatype_destroy(&ddt);
if( (send_data[0] != recv_data[0]) || (send_data[2] != recv_data[2]) ) {
printf("Error during external32 pack/unack for vector types (MPI_INT32_T)\n");
exit(-1);
}
}
ompi_datatype_finalize();
return 0;
}
