int mca_io_ompio_set_view_internal(mca_io_ompio_file_t *fh,
OMPI_MPI_OFFSET_TYPE disp,
ompi_datatype_t *etype,
ompi_datatype_t *filetype,
char *datarep,
ompi_info_t *info)
{
size_t max_data = 0;
MPI_Aint lb,ub;
fh->f_iov_count = 0;
fh->f_disp = disp;
fh->f_offset = disp;
fh->f_total_bytes = 0;
ompi_io_ompio_decode_datatype (fh,
filetype,
1,
NULL,
&max_data,
&fh->f_decoded_iov,
&fh->f_iov_count);
opal_datatype_get_extent(&filetype->super, &lb, &fh->f_view_extent);
opal_datatype_type_ub (&filetype->super, &ub);
opal_datatype_type_size (&etype->super, &fh->f_etype_size);
opal_datatype_type_size (&filetype->super, &fh->f_view_size);
ompi_datatype_duplicate (etype, &fh->f_etype);
ompi_datatype_duplicate (filetype, &fh->f_filetype);
fh->f_cc_size = get_contiguous_chunk_size (fh);
if (opal_datatype_is_contiguous_memory_layout(&etype->super,1)) {
if (opal_datatype_is_contiguous_memory_layout(&filetype->super,1) &&
fh->f_view_extent == (OPAL_PTRDIFF_TYPE)fh->f_view_size ) {
fh->f_flags |= OMPIO_CONTIGUOUS_FVIEW;
}
}
return OMPI_SUCCESS;
}
int mca_io_ompio_file_get_view (struct ompi_file_t *fp,
OMPI_MPI_OFFSET_TYPE *disp,
struct ompi_datatype_t **etype,
struct ompi_datatype_t **filetype,
char *datarep)
{
mca_io_ompio_data_t *data;
mca_io_ompio_file_t *fh;
data = (mca_io_ompio_data_t *) fp->f_io_selected_data;
fh = &data->ompio_fh;
*disp = fh->f_disp;
ompi_datatype_duplicate (fh->f_etype, etype);
ompi_datatype_duplicate (fh->f_filetype, filetype);
strcpy (datarep, fh->f_datarep);
return OMPI_SUCCESS;
}
int32_t ompi_datatype_create_darray(int size,
int rank,
int ndims,
int const* gsize_array,
int const* distrib_array,
int const* darg_array,
int const* psize_array,
int order,
const ompi_datatype_t* oldtype,
ompi_datatype_t** newtype)
{
ompi_datatype_t *lastType;
ptrdiff_t orig_extent, *st_offsets = NULL;
int i, start_loop, end_loop, step;
int *coords = NULL, rc = OMPI_SUCCESS;
/* speedy corner case */
if (ndims < 1) {
/* Don't just return MPI_DATATYPE_NULL as that can't be
MPI_TYPE_FREE()ed, and that seems bad */
*newtype = ompi_datatype_create(0);
ompi_datatype_add(*newtype, &ompi_mpi_datatype_null.dt, 0, 0, 0);
return MPI_SUCCESS;
}
rc = ompi_datatype_type_extent(oldtype, &orig_extent);
if (MPI_SUCCESS != rc) goto cleanup;
/* calculate position in grid using row-major ordering */
{
int tmp_rank = rank, procs = size;
coords = (int *) malloc(ndims * sizeof(int));
for (i = 0 ; i < ndims ; i++) {
procs = procs / psize_array[i];
coords[i] = tmp_rank / procs;
tmp_rank = tmp_rank % procs;
}
}
st_offsets = (ptrdiff_t *) malloc(ndims * sizeof(ptrdiff_t));
/* duplicate type to here to 1) deal with constness without
casting and 2) eliminate need to for conditional destroy below.
Lame, yes. But cleaner code all around. */
rc = ompi_datatype_duplicate(oldtype, &lastType);
if (OMPI_SUCCESS != rc) goto cleanup;
/* figure out ordering issues */
if (MPI_ORDER_C == order) {
start_loop = ndims - 1 ; step = -1; end_loop = -1;
} else {
start_loop = 0 ; step = 1; end_loop = ndims;
}
/* Build up array */
for (i = start_loop; i != end_loop; i += step) {
int nprocs, tmp_rank;
switch(distrib_array[i]) {
case MPI_DISTRIBUTE_BLOCK:
rc = block(gsize_array, i, ndims, psize_array[i], coords[i],
darg_array[i], order, orig_extent,
lastType, newtype, st_offsets+i);
break;
case MPI_DISTRIBUTE_CYCLIC:
rc = cyclic(gsize_array, i, ndims, psize_array[i], coords[i],
darg_array[i], order, orig_extent,
lastType, newtype, st_offsets+i);
break;
case MPI_DISTRIBUTE_NONE:
/* treat it as a block distribution on 1 process */
if (order == MPI_ORDER_C) {
nprocs = psize_array[i]; tmp_rank = coords[i];
} else {
nprocs = 1; tmp_rank = 0;
}
rc = block(gsize_array, i, ndims, nprocs, tmp_rank,
MPI_DISTRIBUTE_DFLT_DARG, order, orig_extent,
lastType, newtype, st_offsets+i);
break;
default:
rc = MPI_ERR_ARG;
}
ompi_datatype_destroy(&lastType);
/* need to destroy the old type even in error condition, so
don't check return code from above until after cleanup. */
if (MPI_SUCCESS != rc) goto cleanup;
lastType = *newtype;
}
/* set displacement and UB correctly. Use struct instead of
resized for same reason as subarray */
{
ptrdiff_t displs[3], tmp_size;
ompi_datatype_t *types[3];
int blength[3] = { 1, 1, 1};
displs[1] = st_offsets[start_loop];
tmp_size = 1;
for (i = start_loop + step ; i != end_loop ; i += step) {
tmp_size *= gsize_array[i - step];
displs[1] += tmp_size * st_offsets[i];
}
displs[0] = 0;
displs[1] *= orig_extent;
displs[2] = orig_extent;
for (i = 0 ; i < ndims ; i++) {
displs[2] *= gsize_array[i];
}
types[0] = MPI_LB; types[1] = lastType; types[2] = MPI_UB;
rc = ompi_datatype_create_struct(3, blength, displs, types, newtype);
ompi_datatype_destroy(&lastType);
/* need to destroy the old type even in error condition, so
don't check return code from above until after cleanup. */
if (MPI_SUCCESS != rc) goto cleanup;
}
cleanup:
if (NULL != st_offsets) free(st_offsets);
if (NULL != coords) free(coords);
return OMPI_SUCCESS;
}
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 mca_io_ompio_set_view_internal(mca_io_ompio_file_t *fh,
OMPI_MPI_OFFSET_TYPE disp,
ompi_datatype_t *etype,
ompi_datatype_t *filetype,
char *datarep,
ompi_info_t *info)
{
size_t max_data = 0;
int i;
int num_groups = 0;
contg *contg_groups;
size_t ftype_size;
OPAL_PTRDIFF_TYPE ftype_extent, lb, ub;
ompi_datatype_t *newfiletype;
if ( NULL != fh->f_etype ) {
ompi_datatype_destroy (&fh->f_etype);
}
if ( NULL != fh->f_filetype ) {
ompi_datatype_destroy (&fh->f_filetype);
}
if ( NULL != fh->f_orig_filetype ) {
ompi_datatype_destroy (&fh->f_orig_filetype);
}
if (NULL != fh->f_decoded_iov) {
free (fh->f_decoded_iov);
fh->f_decoded_iov = NULL;
}
if (NULL != fh->f_datarep) {
free (fh->f_datarep);
fh->f_datarep = NULL;
}
/* Reset the flags first */
fh->f_flags = 0;
fh->f_flags |= OMPIO_FILE_VIEW_IS_SET;
fh->f_datarep = strdup (datarep);
ompi_datatype_duplicate (filetype, &fh->f_orig_filetype );
opal_datatype_get_extent(&filetype->super, &lb, &ftype_extent);
opal_datatype_type_size (&filetype->super, &ftype_size);
if ( etype == filetype &&
ompi_datatype_is_predefined (filetype ) &&
ftype_extent == (OPAL_PTRDIFF_TYPE)ftype_size ){
ompi_datatype_create_contiguous(MCA_IO_DEFAULT_FILE_VIEW_SIZE,
&ompi_mpi_byte.dt,
&newfiletype);
ompi_datatype_commit (&newfiletype);
}
else {
newfiletype = filetype;
}
fh->f_iov_count = 0;
fh->f_disp = disp;
fh->f_offset = disp;
fh->f_total_bytes = 0;
ompi_io_ompio_decode_datatype (fh,
newfiletype,
1,
NULL,
&max_data,
&fh->f_decoded_iov,
&fh->f_iov_count);
opal_datatype_get_extent(&newfiletype->super, &lb, &fh->f_view_extent);
opal_datatype_type_ub (&newfiletype->super, &ub);
opal_datatype_type_size (&etype->super, &fh->f_etype_size);
opal_datatype_type_size (&newfiletype->super, &fh->f_view_size);
ompi_datatype_duplicate (etype, &fh->f_etype);
ompi_datatype_duplicate (newfiletype, &fh->f_filetype);
fh->f_cc_size = get_contiguous_chunk_size (fh);
if (opal_datatype_is_contiguous_memory_layout(&etype->super,1)) {
if (opal_datatype_is_contiguous_memory_layout(&filetype->super,1) &&
fh->f_view_extent == (OPAL_PTRDIFF_TYPE)fh->f_view_size ) {
fh->f_flags |= OMPIO_CONTIGUOUS_FVIEW;
}
}
contg_groups = (contg*) calloc ( 1, fh->f_size * sizeof(contg));
if (NULL == contg_groups) {
opal_output (1, "OUT OF MEMORY\n");
return OMPI_ERR_OUT_OF_RESOURCE;
}
for( i = 0; i < fh->f_size; i++){
contg_groups[i].procs_in_contg_group = (int*)calloc (1,fh->f_size * sizeof(int));
if(NULL == contg_groups[i].procs_in_contg_group){
int j;
opal_output (1, "OUT OF MEMORY\n");
for(j=0; j<i; j++) {
free(contg_groups[j].procs_in_contg_group);
}
free(contg_groups);
return OMPI_ERR_OUT_OF_RESOURCE;
}
}
if( OMPI_SUCCESS != mca_io_ompio_fview_based_grouping(fh,
&num_groups,
contg_groups)){
opal_output(1, "mca_io_ompio_fview_based_grouping() failed\n");
free(contg_groups);
return OMPI_ERROR;
}
if( !( (fh->f_comm->c_flags & OMPI_COMM_CART) &&
(num_groups == 1 || num_groups == fh->f_size)) ) {
mca_io_ompio_finalize_initial_grouping(fh,
num_groups,
contg_groups);
}
for( i = 0; i < fh->f_size; i++){
free(contg_groups[i].procs_in_contg_group);
}
free(contg_groups);
if ( etype == filetype &&
ompi_datatype_is_predefined (filetype ) &&
ftype_extent == (OPAL_PTRDIFF_TYPE)ftype_size ){
ompi_datatype_destroy ( &newfiletype );
}
if (OMPI_SUCCESS != mca_fcoll_base_file_select (fh, NULL)) {
opal_output(1, "mca_fcoll_base_file_select() failed\n");
return OMPI_ERROR;
}
return OMPI_SUCCESS;
}
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 mca_io_ompio_set_view_internal(mca_io_ompio_file_t *fh,
OMPI_MPI_OFFSET_TYPE disp,
ompi_datatype_t *etype,
ompi_datatype_t *filetype,
char *datarep,
ompi_info_t *info)
{
size_t max_data = 0;
int i;
int num_groups = 0;
contg *contg_groups;
MPI_Aint lb,ub;
fh->f_iov_count = 0;
fh->f_disp = disp;
fh->f_offset = disp;
fh->f_total_bytes = 0;
ompi_io_ompio_decode_datatype (fh,
filetype,
1,
NULL,
&max_data,
&fh->f_decoded_iov,
&fh->f_iov_count);
opal_datatype_get_extent(&filetype->super, &lb, &fh->f_view_extent);
opal_datatype_type_ub (&filetype->super, &ub);
opal_datatype_type_size (&etype->super, &fh->f_etype_size);
opal_datatype_type_size (&filetype->super, &fh->f_view_size);
ompi_datatype_duplicate (etype, &fh->f_etype);
ompi_datatype_duplicate (filetype, &fh->f_filetype);
fh->f_cc_size = get_contiguous_chunk_size (fh);
if (opal_datatype_is_contiguous_memory_layout(&etype->super,1)) {
if (opal_datatype_is_contiguous_memory_layout(&filetype->super,1) &&
fh->f_view_extent == (OPAL_PTRDIFF_TYPE)fh->f_view_size ) {
fh->f_flags |= OMPIO_CONTIGUOUS_FVIEW;
}
}
contg_groups = (contg*) calloc ( 1, fh->f_size * sizeof(contg));
if (NULL == contg_groups) {
opal_output (1, "OUT OF MEMORY\n");
return OMPI_ERR_OUT_OF_RESOURCE;
}
for( i = 0; i < fh->f_size; i++) {
contg_groups[i].procs_in_contg_group = (int*)calloc (1,fh->f_size * sizeof(int));
if(NULL == contg_groups[i].procs_in_contg_group) {
int j;
opal_output (1, "OUT OF MEMORY\n");
for(j=0; j<i; j++) {
free(contg_groups[j].procs_in_contg_group);
}
free(contg_groups);
return OMPI_ERR_OUT_OF_RESOURCE;
}
}
if( OMPI_SUCCESS != mca_io_ompio_fview_based_grouping(fh,
&num_groups,
contg_groups)) {
opal_output(1, "mca_io_ompio_fview_based_grouping() failed\n");
free(contg_groups);
return OMPI_ERROR;
}
if( !( (fh->f_comm->c_flags & OMPI_COMM_CART) &&
(num_groups == 1 || num_groups == fh->f_size)) ) {
mca_io_ompio_finalize_initial_grouping(fh,
num_groups,
contg_groups);
}
for( i = 0; i < fh->f_size; i++) {
free(contg_groups[i].procs_in_contg_group);
}
free(contg_groups);
return OMPI_SUCCESS;
}
int mca_io_ompio_file_set_view (ompi_file_t *fp,
OMPI_MPI_OFFSET_TYPE disp,
ompi_datatype_t *etype,
ompi_datatype_t *filetype,
char *datarep,
ompi_info_t *info)
{
mca_io_ompio_data_t *data;
mca_io_ompio_file_t *fh;
size_t ftype_size;
OPAL_PTRDIFF_TYPE ftype_extent, lb;
data = (mca_io_ompio_data_t *) fp->f_io_selected_data;
fh = &data->ompio_fh;
ompi_datatype_destroy (&fh->f_etype);
ompi_datatype_destroy (&fh->f_filetype);
ompi_datatype_destroy (&fh->f_orig_filetype);
if (NULL != fh->f_decoded_iov) {
free (fh->f_decoded_iov);
fh->f_decoded_iov = NULL;
}
if (NULL != fh->f_datarep) {
free (fh->f_datarep);
fh->f_datarep = NULL;
}
/* Reset the flags first */
fh->f_flags = 0;
fh->f_flags |= OMPIO_FILE_VIEW_IS_SET;
fh->f_datarep = strdup (datarep);
ompi_datatype_duplicate (filetype, &fh->f_orig_filetype );
opal_datatype_get_extent(&filetype->super, &lb, &ftype_extent);
opal_datatype_type_size (&filetype->super, &ftype_size);
if ( etype == filetype &&
ompi_datatype_is_predefined (filetype ) &&
ftype_extent == (OPAL_PTRDIFF_TYPE)ftype_size ) {
ompi_datatype_t *newfiletype;
ompi_datatype_create_contiguous(MCA_IO_DEFAULT_FILE_VIEW_SIZE,
&ompi_mpi_byte.dt,
&newfiletype);
ompi_datatype_commit (&newfiletype);
mca_io_ompio_set_view_internal (fh,
disp,
etype,
newfiletype,
datarep,
info);
ompi_datatype_destroy ( &newfiletype );
}
else {
mca_io_ompio_set_view_internal (fh,
disp,
etype,
filetype,
datarep,
info);
}
if (OMPI_SUCCESS != mca_fcoll_base_file_select (&data->ompio_fh,
NULL)) {
opal_output(1, "mca_fcoll_base_file_select() failed\n");
return OMPI_ERROR;
}
return OMPI_SUCCESS;
}
