/*@ MPI_Type_extent - Returns the extent of a datatype Input Parameters: . datatype - datatype (handle) Output Parameters: . extent - datatype extent (address integer) .N SignalSafe .N Deprecated The replacement for this routine is 'MPI_Type_get_extent'. .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TYPE @*/ int MPI_Type_extent(MPI_Datatype datatype, MPI_Aint *extent) { int mpi_errno = MPI_SUCCESS; MPID_Datatype *datatype_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_EXTENT); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_EXTENT); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* Convert MPI object handles to object pointers */ MPID_Datatype_get_ptr(datatype, datatype_ptr); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate datatype_ptr */ MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ MPIR_Type_extent_impl(datatype, extent); /* ... end of body of routine ... */ #ifdef HAVE_ERROR_CHECKING fn_exit: #endif MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_EXTENT); return mpi_errno; /* --BEGIN ERROR HANDLING-- */ # ifdef HAVE_ERROR_CHECKING fn_fail: { mpi_errno = MPIR_Err_create_code( mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_type_extent", "**mpi_type_extent %D %p", datatype, extent); } mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; # endif /* --END ERROR HANDLING-- */ }
void PREPEND_PREFIX(Type_calc_footprint)(MPI_Datatype type, DLOOP_Type_footprint *tfp) { int mpi_errno; int nr_ints, nr_aints, nr_types, combiner; int *ints; MPI_Aint *aints; MPI_Datatype *types; /* used to store parameters for constituent types */ DLOOP_Offset size = 0, lb = 0, ub = 0, true_lb = 0, true_ub = 0; DLOOP_Offset extent = 0, alignsz; int has_sticky_lb, has_sticky_ub; /* used for vector/hvector/hvector_integer calculations */ DLOOP_Offset stride; /* used for indexed/hindexed calculations */ DLOOP_Offset disp; /* used for calculations on types with more than one block of data */ DLOOP_Offset i, min_lb, max_ub, ntypes, tmp_lb, tmp_ub; /* used for processing subarray and darray types */ int ndims; MPI_Datatype tmptype; MPIR_Type_get_envelope_impl(type, &nr_ints, &nr_aints, &nr_types, &combiner); if (combiner == MPI_COMBINER_NAMED) { int mpisize; MPI_Aint mpiextent; MPIR_Type_size_impl(type, &mpisize); MPIR_Type_extent_impl(type, &mpiextent); tfp->size = (DLOOP_Offset) mpisize; tfp->lb = 0; tfp->ub = (DLOOP_Offset) mpiextent; tfp->true_lb = 0; tfp->true_ub = (DLOOP_Offset) mpiextent; tfp->extent = (DLOOP_Offset) mpiextent; tfp->alignsz = DLOOP_Named_type_alignsize(type, (MPI_Aint) 0); tfp->has_sticky_lb = (type == MPI_LB) ? 1 : 0; tfp->has_sticky_ub = (type == MPI_UB) ? 1 : 0; goto clean_exit; } /* get access to contents; need it immediately to check for zero count */ PREPEND_PREFIX(Type_access_contents)(type, &ints, &aints, &types); /* knock out all the zero count cases */ if ((combiner == MPI_COMBINER_CONTIGUOUS || combiner == MPI_COMBINER_VECTOR || combiner == MPI_COMBINER_HVECTOR_INTEGER || combiner == MPI_COMBINER_HVECTOR || combiner == MPI_COMBINER_INDEXED_BLOCK || combiner == MPI_COMBINER_HINDEXED_BLOCK || combiner == MPI_COMBINER_INDEXED || combiner == MPI_COMBINER_HINDEXED_INTEGER || combiner == MPI_COMBINER_STRUCT_INTEGER || combiner == MPI_COMBINER_STRUCT) && ints[0] == 0) { tfp->size = tfp->lb = tfp->ub = tfp->extent = tfp->alignsz = 0; tfp->true_lb = tfp->true_ub = 0; tfp->has_sticky_lb = tfp->has_sticky_ub = 0; goto clean_exit; } if (combiner != MPI_COMBINER_STRUCT && combiner != MPI_COMBINER_STRUCT_INTEGER) { DLOOP_Type_footprint cfp; PREPEND_PREFIX(Type_calc_footprint)(types[0], &cfp); size = cfp.size; lb = cfp.lb; ub = cfp.ub; true_lb = cfp.true_lb; true_ub = cfp.true_ub; extent = cfp.extent; alignsz = cfp.alignsz; has_sticky_lb = cfp.has_sticky_lb; has_sticky_ub = cfp.has_sticky_ub; /* initialize some common values so we don't have to assign * them in every case below. */ tfp->alignsz = alignsz; tfp->has_sticky_lb = has_sticky_lb; tfp->has_sticky_ub = has_sticky_ub; } switch(combiner) { case MPI_COMBINER_DUP: tfp->size = size; tfp->lb = lb; tfp->ub = ub; tfp->true_lb = true_lb; tfp->true_ub = true_ub; tfp->extent = extent; break; case MPI_COMBINER_RESIZED: tfp->size = size; tfp->lb = aints[0]; /* lb */ tfp->ub = aints[0] + aints[1]; tfp->true_lb = true_lb; tfp->true_ub = true_ub; tfp->extent = aints[1]; /* extent */ tfp->has_sticky_lb = 1; tfp->has_sticky_ub = 1; break; case MPI_COMBINER_CONTIGUOUS: DLOOP_DATATYPE_CONTIG_LB_UB(ints[0] /* count */, lb, ub, extent, tfp->lb, tfp->ub); tfp->true_lb = tfp->lb + (true_lb - lb); tfp->true_ub = tfp->ub + (true_ub - ub); tfp->size = (DLOOP_Offset) ints[0] * size; tfp->extent = tfp->ub - tfp->lb; break; case MPI_COMBINER_VECTOR: case MPI_COMBINER_HVECTOR: case MPI_COMBINER_HVECTOR_INTEGER: if (combiner == MPI_COMBINER_VECTOR) stride = (DLOOP_Offset) ints[2] * extent; else if (combiner == MPI_COMBINER_HVECTOR) stride = aints[0]; else /* HVECTOR_INTEGER */ stride = (DLOOP_Offset) ints[2]; DLOOP_DATATYPE_VECTOR_LB_UB(ints[0] /* count */, stride /* stride in bytes */, ints[1] /* blklen */, lb, ub, extent, tfp->lb, tfp->ub); tfp->true_lb = tfp->lb + (true_lb - lb); tfp->true_ub = tfp->ub + (true_ub - ub); tfp->size = (DLOOP_Offset) ints[0] * (DLOOP_Offset) ints[1] * size; tfp->extent = tfp->ub - tfp->lb; break; case MPI_COMBINER_INDEXED_BLOCK: /* prime min_lb and max_ub */ DLOOP_DATATYPE_BLOCK_LB_UB(ints[1] /* blklen */, (DLOOP_Offset) ints[2] * extent /* disp */, lb, ub, extent, min_lb, max_ub); for (i=1; i < ints[0]; i++) { DLOOP_DATATYPE_BLOCK_LB_UB(ints[1] /* blklen */, (DLOOP_Offset) ints[i+2] * extent /* disp */, lb, ub, extent, tmp_lb, tmp_ub); if (tmp_lb < min_lb) min_lb = tmp_lb; if (tmp_ub > max_ub) max_ub = tmp_ub; } tfp->size = (DLOOP_Offset) ints[0] * (DLOOP_Offset) ints[1] * size; tfp->lb = min_lb; tfp->ub = max_ub; tfp->true_lb = min_lb + (true_lb - lb); tfp->true_ub = max_ub + (true_ub - ub); tfp->extent = tfp->ub - tfp->lb; break; case MPI_COMBINER_HINDEXED_BLOCK: /* prime min_lb and max_ub */ DLOOP_DATATYPE_BLOCK_LB_UB(ints[1] /* blklen */, (DLOOP_Offset) ints[2] /* disp */, lb, ub, extent, min_lb, max_ub); for (i=1; i < ints[0]; i++) { DLOOP_DATATYPE_BLOCK_LB_UB(ints[1] /* blklen */, (DLOOP_Offset) ints[i+2] /* disp */, lb, ub, extent, tmp_lb, tmp_ub); if (tmp_lb < min_lb) min_lb = tmp_lb; if (tmp_ub > max_ub) max_ub = tmp_ub; } tfp->size = (DLOOP_Offset) ints[0] * (DLOOP_Offset) ints[1] * size; tfp->lb = min_lb; tfp->ub = max_ub; tfp->true_lb = min_lb + (true_lb - lb); tfp->true_ub = max_ub + (true_ub - ub); tfp->extent = tfp->ub - tfp->lb; break; case MPI_COMBINER_INDEXED: case MPI_COMBINER_HINDEXED_INTEGER: case MPI_COMBINER_HINDEXED: /* find first non-zero blocklength element */ for (i=0; i < ints[0] && ints[i+1] == 0; i++); if (i == ints[0]) { /* all zero blocklengths */ tfp->size = tfp->lb = tfp->ub = tfp->extent = tfp->alignsz = 0; tfp->has_sticky_lb = tfp->has_sticky_ub = 0; } else { /* prime min_lb, max_ub, count */ ntypes = ints[i+1]; if (combiner == MPI_COMBINER_INDEXED) disp = (DLOOP_Offset) ints[ints[0]+i+1] * extent; else if (combiner == MPI_COMBINER_HINDEXED_INTEGER) disp = (DLOOP_Offset) ints[ints[0]+i+1]; else /* MPI_COMBINER_HINDEXED */ disp = aints[i]; DLOOP_DATATYPE_BLOCK_LB_UB(ints[i+1] /* blklen */, disp, lb, ub, extent, min_lb, max_ub); for (i++; i < ints[0]; i++) { /* skip zero blocklength elements */ if (ints[i+1] == 0) continue; ntypes += ints[i+1]; if (combiner == MPI_COMBINER_INDEXED) disp = (DLOOP_Offset) ints[ints[0]+i+1] * extent; else if (combiner == MPI_COMBINER_HINDEXED_INTEGER) disp = (DLOOP_Offset) ints[ints[0]+i+1]; else /* MPI_COMBINER_HINDEXED */ disp = aints[i]; DLOOP_DATATYPE_BLOCK_LB_UB(ints[i+1], disp, lb, ub, extent, tmp_lb, tmp_ub); if (tmp_lb < min_lb) min_lb = tmp_lb; if (tmp_ub > max_ub) max_ub = tmp_ub; } tfp->size = ntypes * size; tfp->lb = min_lb; tfp->ub = max_ub; tfp->true_lb = min_lb + (true_lb - lb); tfp->true_ub = max_ub + (true_ub - ub); tfp->extent = tfp->ub - tfp->lb; } break; case MPI_COMBINER_STRUCT_INTEGER: DLOOP_Assert(combiner != MPI_COMBINER_STRUCT_INTEGER); break; case MPI_COMBINER_STRUCT: /* sufficiently complicated to pull out into separate fn */ DLOOP_Type_calc_footprint_struct(type, combiner, ints, aints, types, tfp); break; case MPI_COMBINER_SUBARRAY: ndims = ints[0]; PREPEND_PREFIX(Type_convert_subarray)(ndims, &ints[1] /* sizes */, &ints[1+ndims] /* subsz */, &ints[1+2*ndims] /* strts */, ints[1+3*ndims] /* order */, types[0], &tmptype); PREPEND_PREFIX(Type_calc_footprint)(tmptype, tfp); MPIR_Type_free_impl(&tmptype); break; case MPI_COMBINER_DARRAY: ndims = ints[2]; PREPEND_PREFIX(Type_convert_darray)(ints[0] /* size */, ints[1] /* rank */, ndims, &ints[3] /* gsizes */, &ints[3+ndims] /*distribs */, &ints[3+2*ndims] /* dargs */, &ints[3+3*ndims] /* psizes */, ints[3+4*ndims] /* order */, types[0], &tmptype); PREPEND_PREFIX(Type_calc_footprint)(tmptype, tfp); MPIR_Type_free_impl(&tmptype); break; case MPI_COMBINER_F90_REAL: case MPI_COMBINER_F90_COMPLEX: case MPI_COMBINER_F90_INTEGER: default: DLOOP_Assert(0); break; } clean_exit: PREPEND_PREFIX(Type_release_contents)(type, &ints, &aints, &types); return; }
/*@ MPI_Type_create_subarray - Create a datatype for a subarray of a regular, multidimensional array Input Parameters: + ndims - number of array dimensions (positive integer) . array_of_sizes - number of elements of type oldtype in each dimension of the full array (array of positive integers) . array_of_subsizes - number of elements of type oldtype in each dimension of the subarray (array of positive integers) . array_of_starts - starting coordinates of the subarray in each dimension (array of nonnegative integers) . order - array storage order flag (state) - oldtype - array element datatype (handle) Output Parameters: . newtype - new datatype (handle) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TYPE .N MPI_ERR_ARG @*/ int MPI_Type_create_subarray(int ndims, const int array_of_sizes[], const int array_of_subsizes[], const int array_of_starts[], int order, MPI_Datatype oldtype, MPI_Datatype *newtype) { static const char FCNAME[] = "MPI_Type_create_subarray"; int mpi_errno = MPI_SUCCESS, i; MPI_Datatype new_handle; /* these variables are from the original version in ROMIO */ MPI_Aint size, extent, disps[3]; MPI_Datatype tmp1, tmp2; # ifdef HAVE_ERROR_CHECKING MPI_Aint size_with_aint; MPI_Offset size_with_offset; # endif /* for saving contents */ int *ints; MPID_Datatype *new_dtp; MPIU_CHKLMEM_DECL(1); MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_CREATE_SUBARRAY); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_CREATE_SUBARRAY); # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPID_Datatype *datatype_ptr = NULL; /* Check parameters */ MPIR_ERRTEST_ARGNONPOS(ndims, "ndims", mpi_errno, MPI_ERR_DIMS); MPIR_ERRTEST_ARGNULL(array_of_sizes, "array_of_sizes", mpi_errno); MPIR_ERRTEST_ARGNULL(array_of_subsizes, "array_of_subsizes", mpi_errno); MPIR_ERRTEST_ARGNULL(array_of_starts, "array_of_starts", mpi_errno); for (i=0; mpi_errno == MPI_SUCCESS && i < ndims; i++) { MPIR_ERRTEST_ARGNONPOS(array_of_sizes[i], "size", mpi_errno, MPI_ERR_ARG); MPIR_ERRTEST_ARGNONPOS(array_of_subsizes[i], "subsize", mpi_errno, MPI_ERR_ARG); MPIR_ERRTEST_ARGNEG(array_of_starts[i], "start", mpi_errno); if (array_of_subsizes[i] > array_of_sizes[i]) { mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**argrange", "**argrange %s %d %d", "array_of_subsizes", array_of_subsizes[i], array_of_sizes[i]); goto fn_fail; } if (array_of_starts[i] > (array_of_sizes[i] - array_of_subsizes[i])) { mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**argrange", "**argrange %s %d %d", "array_of_starts", array_of_starts[i], array_of_sizes[i] - array_of_subsizes[i]); goto fn_fail; } } if (order != MPI_ORDER_FORTRAN && order != MPI_ORDER_C) { mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_ARG, "**arg", "**arg %s", "order"); goto fn_fail; } MPIR_Type_extent_impl(oldtype, &extent); /* check if MPI_Aint is large enough for size of global array. if not, complain. */ size_with_aint = extent; for (i=0; i<ndims; i++) size_with_aint *= array_of_sizes[i]; size_with_offset = extent; for (i=0; i<ndims; i++) size_with_offset *= array_of_sizes[i]; if (size_with_aint != size_with_offset) { mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_FATAL, FCNAME, __LINE__, MPI_ERR_ARG, "**subarrayoflow", "**subarrayoflow %L", size_with_offset); goto fn_fail; } /* Get handles to MPI objects. */ MPID_Datatype_get_ptr(oldtype, datatype_ptr); /* Validate datatype_ptr */ MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno); /* If datatype_ptr is not valid, it will be reset to null */ if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ /* TODO: CHECK THE ERROR RETURNS FROM ALL THESE!!! */ /* TODO: GRAB EXTENT WITH A MACRO OR SOMETHING FASTER */ MPIR_Type_extent_impl(oldtype, &extent); if (order == MPI_ORDER_FORTRAN) { if (ndims == 1) mpi_errno = MPID_Type_contiguous(array_of_subsizes[0], oldtype, &tmp1); else { mpi_errno = MPID_Type_vector(array_of_subsizes[1], array_of_subsizes[0], (MPI_Aint)(array_of_sizes[0]), 0, /* stride in types */ oldtype, &tmp1); if (mpi_errno) MPIR_ERR_POP(mpi_errno); size = ((MPI_Aint)(array_of_sizes[0])) * extent; for (i=2; i<ndims; i++) { size *= (MPI_Aint)(array_of_sizes[i-1]); mpi_errno = MPID_Type_vector(array_of_subsizes[i], 1, size, 1, /* stride in bytes */ tmp1, &tmp2); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_Type_free_impl(&tmp1); tmp1 = tmp2; } } if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* add displacement and UB */ disps[1] = (MPI_Aint)(array_of_starts[0]); size = 1; for (i=1; i<ndims; i++) { size *= (MPI_Aint)(array_of_sizes[i-1]); disps[1] += size * (MPI_Aint)(array_of_starts[i]); } /* rest done below for both Fortran and C order */ } else /* MPI_ORDER_C */ { /* dimension ndims-1 changes fastest */ if (ndims == 1) { mpi_errno = MPID_Type_contiguous(array_of_subsizes[0], oldtype, &tmp1); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } else { mpi_errno = MPID_Type_vector(array_of_subsizes[ndims-2], array_of_subsizes[ndims-1], (MPI_Aint)(array_of_sizes[ndims-1]), 0, /* stride in types */ oldtype, &tmp1); if (mpi_errno) MPIR_ERR_POP(mpi_errno); size = (MPI_Aint)(array_of_sizes[ndims-1]) * extent; for (i=ndims-3; i>=0; i--) { size *= (MPI_Aint)(array_of_sizes[i+1]); mpi_errno = MPID_Type_vector(array_of_subsizes[i], 1, /* blocklen */ size, /* stride */ 1, /* stride in bytes */ tmp1, /* old type */ &tmp2); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_Type_free_impl(&tmp1); tmp1 = tmp2; } } /* add displacement and UB */ disps[1] = (MPI_Aint)(array_of_starts[ndims-1]); size = 1; for (i=ndims-2; i>=0; i--) { size *= (MPI_Aint)(array_of_sizes[i+1]); disps[1] += size * (MPI_Aint)(array_of_starts[i]); } } disps[1] *= extent; disps[2] = extent; for (i=0; i<ndims; i++) disps[2] *= (MPI_Aint)(array_of_sizes[i]); disps[0] = 0; /* Instead of using MPI_LB/MPI_UB, which have been removed from MPI in MPI-3, use MPI_Type_create_resized. Use hindexed_block to set the starting displacement of the datatype (disps[1]) and type_create_resized to set lb to 0 (disps[0]) and extent to disps[2], which makes ub = disps[2]. */ mpi_errno = MPID_Type_blockindexed(1, 1, &disps[1], 1, /* 1 means disp is in bytes */ tmp1, &tmp2); if (mpi_errno) MPIR_ERR_POP(mpi_errno); mpi_errno = MPID_Type_create_resized(tmp2, 0, disps[2], &new_handle); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_Type_free_impl(&tmp1); MPIR_Type_free_impl(&tmp2); /* at this point we have the new type, and we've cleaned up any * intermediate types created in the process. we just need to save * all our contents/envelope information. */ /* Save contents */ MPIU_CHKLMEM_MALLOC_ORJUMP(ints, int *, (3 * ndims + 2) * sizeof(int), mpi_errno, "content description"); ints[0] = ndims; for (i=0; i < ndims; i++) { ints[i + 1] = array_of_sizes[i]; } for(i=0; i < ndims; i++) { ints[i + ndims + 1] = array_of_subsizes[i]; } for(i=0; i < ndims; i++) { ints[i + 2*ndims + 1] = array_of_starts[i]; } ints[3*ndims + 1] = order; MPID_Datatype_get_ptr(new_handle, new_dtp); mpi_errno = MPID_Datatype_set_contents(new_dtp, MPI_COMBINER_SUBARRAY, 3 * ndims + 2, /* ints */ 0, /* aints */ 1, /* types */ ints, NULL, &oldtype); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_OBJ_PUBLISH_HANDLE(*newtype, new_handle); /* ... end of body of routine ... */ fn_exit: MPIU_CHKLMEM_FREEALL(); MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_CREATE_SUBARRAY); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); 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_create_subarray", "**mpi_type_create_subarray %d %p %p %p %d %D %p", ndims, array_of_sizes, array_of_subsizes, array_of_starts, order, oldtype, newtype); } # endif mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }