void ompi_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)
{
int c_ierr;
MPI_Datatype c_old = PMPI_Type_f2c(*oldtype);
MPI_Datatype c_new;
OMPI_ARRAY_NAME_DECL(array_of_blocklengths);
OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count);
c_ierr = PMPI_Type_create_hindexed(OMPI_FINT_2_INT(*count),
OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths),
array_of_displacements, c_old,
&c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths);
}
void ompi_type_create_subarray_f(MPI_Fint *ndims, MPI_Fint *size_array,
MPI_Fint *subsize_array,
MPI_Fint *start_array, MPI_Fint *order,
MPI_Fint *oldtype, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old;
MPI_Datatype c_new;
OMPI_ARRAY_NAME_DECL(size_array);
OMPI_ARRAY_NAME_DECL(subsize_array);
OMPI_ARRAY_NAME_DECL(start_array);
c_old = PMPI_Type_f2c(*oldtype);
OMPI_ARRAY_FINT_2_INT(size_array, *ndims);
OMPI_ARRAY_FINT_2_INT(subsize_array, *ndims);
OMPI_ARRAY_FINT_2_INT(start_array, *ndims);
c_ierr = PMPI_Type_create_subarray(OMPI_FINT_2_INT(*ndims),
OMPI_ARRAY_NAME_CONVERT(size_array),
OMPI_ARRAY_NAME_CONVERT(subsize_array),
OMPI_ARRAY_NAME_CONVERT(start_array),
*order, c_old, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(size_array);
OMPI_ARRAY_FINT_2_INT_CLEANUP(subsize_array);
OMPI_ARRAY_FINT_2_INT_CLEANUP(start_array);
}
/*
* C->Fortran intercept for the extent calculation.
*/
static int extent_intercept_fn(MPI_Datatype type_c, MPI_Aint *file_extent_f77,
void *extra_state)
{
MPI_Fint ierr, type_f77 = PMPI_Type_c2f(type_c);
ompi_intercept_extra_state_t *intercept_data =
(ompi_intercept_extra_state_t*) extra_state;
intercept_data->extent_fn_f77(&type_f77, file_extent_f77,
intercept_data->extra_state_f77, &ierr);
return OMPI_FINT_2_INT(ierr);
}
void ompi_type_create_f90_integer_f(MPI_Fint *r, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_new;
c_ierr = PMPI_Type_create_f90_integer(OMPI_FINT_2_INT(*r), &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
}
/*
* C->Fortran intercept for the write conversion.
*/
static int write_intercept_fn(void *userbuf, MPI_Datatype type_c, int count_c,
void *filebuf, MPI_Offset position,
void *extra_state)
{
MPI_Fint ierr, count_f77 = OMPI_FINT_2_INT(count_c);
MPI_Fint type_f77 = PMPI_Type_c2f(type_c);
ompi_intercept_extra_state_t *intercept_data =
(ompi_intercept_extra_state_t*) extra_state;
intercept_data->write_fn_f77((char *) userbuf, &type_f77, &count_f77, (char *) filebuf,
&position, intercept_data->extra_state_f77,
&ierr);
return OMPI_FINT_2_INT(ierr);
}
void ompi_type_create_resized_f(MPI_Fint *oldtype, MPI_Aint *lb,
MPI_Aint *extent, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old = PMPI_Type_f2c(*oldtype);
MPI_Datatype c_new;
c_ierr = PMPI_Type_create_resized(c_old, *lb, *extent, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
}
void ompi_type_create_hindexed_block_f(MPI_Fint *count, MPI_Fint *blocklength,
MPI_Aint *array_of_displacements,
MPI_Fint *oldtype, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old = PMPI_Type_f2c(*oldtype);
MPI_Datatype c_new;
c_ierr = PMPI_Type_create_hindexed_block(OMPI_FINT_2_INT(*count),
OMPI_FINT_2_INT(*blocklength),
array_of_displacements,
c_old, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
}
void ompi_type_struct_f(MPI_Fint *count, MPI_Fint *array_of_blocklengths,
MPI_Fint *array_of_displacements,
MPI_Fint *array_of_types, MPI_Fint *newtype,
MPI_Fint *ierr)
{
MPI_Aint *c_disp_array;
MPI_Datatype *c_type_old_array;
MPI_Datatype c_new;
int i, c_ierr;
OMPI_ARRAY_NAME_DECL(array_of_blocklengths);
c_type_old_array = (MPI_Datatype *) malloc(*count * (sizeof(MPI_Datatype) +
sizeof(MPI_Aint)));
if (NULL == c_type_old_array) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_NO_MEM,
FUNC_NAME);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
c_disp_array = (MPI_Aint*) c_type_old_array + *count;
for (i = 0; i < *count; i++) {
c_disp_array[i] = (MPI_Aint) array_of_displacements[i];
c_type_old_array[i] = PMPI_Type_f2c(array_of_types[i]);
}
OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count);
c_ierr = PMPI_Type_struct(OMPI_FINT_2_INT(*count),
OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths),
c_disp_array,
c_type_old_array, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths);
free(c_type_old_array);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
}
MPI_Fint MPI_Type_c2f(MPI_Datatype datatype){
return PMPI_Type_c2f( datatype);
}
