int MPIR_Type_indexed_impl(int count, const int *array_of_blocklengths,
const int *array_of_displacements,
MPI_Datatype oldtype, MPI_Datatype *newtype)
{
int mpi_errno = MPI_SUCCESS;
MPI_Datatype new_handle;
MPID_Datatype *new_dtp;
int i, *ints;
MPIU_CHKLMEM_DECL(1);
mpi_errno = MPID_Type_indexed(count,
array_of_blocklengths,
array_of_displacements,
0, /* displacements not in bytes */
oldtype,
&new_handle);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* copy all integer values into a temporary buffer; this
* includes the count, the blocklengths, and the displacements.
*/
MPIU_CHKLMEM_MALLOC(ints, int *, (2 * count + 1) * sizeof(int), mpi_errno, "contents integer array");
ints[0] = count;
for (i=0; i < count; i++) {
ints[i+1] = array_of_blocklengths[i];
}
for (i=0; i < count; i++) {
ints[i + count + 1] = array_of_displacements[i];
}
MPID_Datatype_get_ptr(new_handle, new_dtp);
mpi_errno = MPID_Datatype_set_contents(new_dtp,
MPI_COMBINER_INDEXED,
2*count + 1, /* ints */
0, /* aints */
1, /* types */
ints,
NULL,
&oldtype);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_OBJ_PUBLISH_HANDLE(*newtype, new_handle);
fn_exit:
MPIU_CHKLMEM_FREEALL();
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
MPI_Type_hindexed - Creates an indexed datatype with offsets in bytes
Input Parameters:
+ count - number of blocks -- also number of entries in indices and blocklens
. blocklens - number of elements in each block (array of nonnegative integers)
. indices - byte displacement of each block (array of MPI_Aint)
- old_type - old datatype (handle)
Output Parameter:
. newtype - new datatype (handle)
.N Deprecated
This routine is replaced by 'MPI_Type_create_hindexed'.
.N ThreadSafe
.N Fortran
The indices are displacements, and are based on a zero origin. A common error
is to do something like to following
.vb
integer a(100)
integer blens(10), indices(10)
do i=1,10
blens(i) = 1
10 indices(i) = (1 + (i-1)*10) * sizeofint
call MPI_TYPE_HINDEXED(10,blens,indices,MPI_INTEGER,newtype,ierr)
call MPI_TYPE_COMMIT(newtype,ierr)
call MPI_SEND(a,1,newtype,...)
.ve
expecting this to send 'a(1),a(11),...' because the indices have values
'1,11,...'. Because these are `displacements` from the beginning of 'a',
it actually sends 'a(1+1),a(1+11),...'.
If you wish to consider the displacements as indices into a Fortran array,
consider declaring the Fortran array with a zero origin
.vb
integer a(0:99)
.ve
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
.N MPI_ERR_COUNT
.N MPI_ERR_EXHAUSTED
.N MPI_ERR_ARG
@*/
int MPI_Type_hindexed(int count,
int blocklens[],
MPI_Aint indices[],
MPI_Datatype old_type,
MPI_Datatype *newtype)
{
static const char FCNAME[] = "MPI_Type_hindexed";
int mpi_errno = MPI_SUCCESS;
MPI_Datatype new_handle;
MPID_Datatype *new_dtp;
int i, *ints;
MPIU_CHKLMEM_DECL(1);
MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_HINDEXED);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_HINDEXED);
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
int j;
MPID_Datatype *datatype_ptr = NULL;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_DATATYPE(old_type, "datatype", mpi_errno);
if (count > 0) {
MPIR_ERRTEST_ARGNULL(blocklens, "blocklens", mpi_errno);
MPIR_ERRTEST_ARGNULL(indices, "indices", mpi_errno);
}
if (mpi_errno == MPI_SUCCESS) {
if (HANDLE_GET_KIND(old_type) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr( old_type, datatype_ptr );
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
}
/* verify that all blocklengths are >= 0 */
for (j=0; j < count; j++) {
MPIR_ERRTEST_ARGNEG(blocklens[j], "blocklen", mpi_errno);
}
}
MPIR_ERRTEST_ARGNULL(newtype, "newtype", mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Type_indexed(count,
blocklens,
indices,
1, /* displacements in bytes */
old_type,
&new_handle);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIU_CHKLMEM_MALLOC(ints, int *, (count + 1) * sizeof(int), mpi_errno, "contents integer array");
/* copy ints into temporary buffer (count and blocklengths) */
ints[0] = count;
for (i=0; i < count; i++)
{
ints[i+1] = blocklens[i];
}
MPID_Datatype_get_ptr(new_handle, new_dtp);
mpi_errno = MPID_Datatype_set_contents(new_dtp,
MPI_COMBINER_HINDEXED,
count+1, /* ints */
count, /* aints (displs) */
1, /* types */
ints,
indices,
&old_type);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIU_OBJ_PUBLISH_HANDLE(*newtype, new_handle);
/* ... end of body of routine ... */
fn_exit:
MPIU_CHKLMEM_FREEALL();
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_HINDEXED);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_type_hindexed",
"**mpi_type_hindexed %d %p %p %D %p", count, blocklens, indices, old_type, newtype);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
