/*@ MPI_Type_contiguous - Creates a contiguous datatype Input Parameters: + count - replication count (nonnegative integer) - oldtype - old datatype (handle) Output Parameter: . newtype - new datatype (handle) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_TYPE .N MPI_ERR_COUNT .N MPI_ERR_EXHAUSTED @*/ int MPI_Type_contiguous(int count, MPI_Datatype old_type, MPI_Datatype *new_type_p) { int mpi_errno = MPI_SUCCESS; MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_CONTIGUOUS); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIU_THREAD_CS_ENTER(ALLFUNC,); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_CONTIGUOUS); # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPID_Datatype *datatype_ptr = NULL; /* MPIR_ERRTEST_XXX macros defined in mpiimpl.h */ MPIR_ERRTEST_COUNT(count, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_ERRTEST_DATATYPE(old_type, "datatype", mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; 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); } if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Type_contiguous_impl(count, old_type, new_type_p); if (mpi_errno) MPIU_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_CONTIGUOUS); 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_contiguous", "**mpi_type_contiguous %d %D %p", count, old_type, new_type_p); } # endif mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
int MPIR_Type_contiguous_x_impl(MPI_Count count, MPI_Datatype oldtype, MPI_Datatype *newtype) { /* to make 'count' fit MPI-3 type processing routines (which take integer * counts), we construct a type consisting of N INT_MAX chunks followed by * a remainder. e.g for a count of 4000000000 bytes you would end up with * one 2147483647-byte chunk followed immediately by a 1852516353-byte * chunk */ MPI_Datatype chunks, remainder; MPI_Aint lb, extent, disps[2]; int blocklens[2]; MPI_Datatype types[2]; int mpi_errno; /* truly stupendously large counts will overflow an integer with this math, * but that is a problem for a few decades from now. Sorry, few decades * from now! */ MPIR_Assert(count/INT_MAX == (int)(count/INT_MAX)); int c = (int)(count/INT_MAX); /* OK to cast until 'count' is 256 bits */ int r = count%INT_MAX; mpi_errno = MPIR_Type_vector_impl(c, INT_MAX, INT_MAX, oldtype, &chunks); if (mpi_errno != MPI_SUCCESS) goto fn_fail; mpi_errno = MPIR_Type_contiguous_impl(r, oldtype, &remainder); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Type_get_extent_impl(oldtype, &lb, &extent); blocklens[0] = 1; blocklens[1] = 1; disps[0] = 0; disps[1] = c*extent*INT_MAX; types[0] = chunks; types[1] = remainder; mpi_errno = MPIR_Type_create_struct_impl(2, blocklens, disps, types, newtype); MPIR_Type_free_impl(&chunks); MPIR_Type_free_impl(&remainder); fn_exit: return mpi_errno; fn_fail: goto fn_exit; }
int MPII_Dataloop_convert_subarray(int ndims, int *array_of_sizes, int *array_of_subsizes, int *array_of_starts, int order, MPI_Datatype oldtype, MPI_Datatype * newtype) { int mpi_errno = MPI_SUCCESS; MPI_Aint extent, disps[3], size; int i, blklens[3]; MPI_Datatype tmp1, tmp2, types[3]; MPIR_Datatype_get_extent_macro(oldtype, extent); if (order == MPI_ORDER_FORTRAN) { /* dimension 0 changes fastest */ if (ndims == 1) { mpi_errno = MPIR_Type_contiguous_impl(array_of_subsizes[0], oldtype, &tmp1); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } else { mpi_errno = MPIR_Type_vector_impl(array_of_subsizes[1], array_of_subsizes[0], array_of_sizes[0], 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 = MPIR_Type_hvector_impl(array_of_subsizes[i], 1, size, tmp1, &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[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 { /* order == MPI_ORDER_C */ /* dimension ndims-1 changes fastest */ if (ndims == 1) { mpi_errno = MPIR_Type_contiguous_impl(array_of_subsizes[0], oldtype, &tmp1); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } else { mpi_errno = MPIR_Type_vector_impl(array_of_subsizes[ndims - 2], array_of_subsizes[ndims - 1], array_of_sizes[ndims - 1], 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 = MPIR_Type_hvector_impl(array_of_subsizes[i], 1, size, tmp1, &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; blklens[0] = blklens[1] = blklens[2] = 1; types[0] = MPI_LB; types[1] = tmp1; types[2] = MPI_UB; mpi_errno = MPIR_Type_struct_impl(3, blklens, disps, types, newtype); if (mpi_errno) MPIR_ERR_POP(mpi_errno); MPIR_Type_free_impl(&tmp1); fn_exit: return mpi_errno; fn_fail: goto fn_exit; }
static int MPII_Type_block(int *array_of_gsizes, int dim, int ndims, int nprocs, int rank, int darg, int order, MPI_Aint orig_extent, MPI_Datatype type_old, MPI_Datatype * type_new, MPI_Aint * st_offset) { /* nprocs = no. of processes in dimension dim of grid rank = coordinate of this process in dimension dim */ int mpi_errno = MPI_SUCCESS; int blksize, global_size, mysize, i, j; MPI_Aint stride; global_size = array_of_gsizes[dim]; if (darg == MPI_DISTRIBUTE_DFLT_DARG) blksize = (global_size + nprocs - 1) / nprocs; else { blksize = darg; MPIR_ERR_CHKINTERNAL(blksize <= 0, mpi_errno, "blksize must be > 0"); MPIR_ERR_CHKINTERNAL(blksize * nprocs < global_size, mpi_errno, "blksize * nprocs must be >= global size"); } j = global_size - blksize * rank; mysize = (blksize < j) ? blksize : j; if (mysize < 0) mysize = 0; stride = orig_extent; if (order == MPI_ORDER_FORTRAN) { if (dim == 0) { mpi_errno = MPIR_Type_contiguous_impl(mysize, type_old, type_new); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } else { for (i = 0; i < dim; i++) stride *= (MPI_Aint) (array_of_gsizes[i]); mpi_errno = MPIR_Type_hvector_impl(mysize, 1, stride, type_old, type_new); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } } else { if (dim == ndims - 1) { mpi_errno = MPIR_Type_contiguous_impl(mysize, type_old, type_new); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } else { for (i = ndims - 1; i > dim; i--) stride *= (MPI_Aint) (array_of_gsizes[i]); mpi_errno = MPIR_Type_hvector_impl(mysize, 1, stride, type_old, type_new); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } } *st_offset = blksize * rank; /* in terms of no. of elements of type oldtype in this dimension */ if (mysize == 0) *st_offset = 0; fn_exit: return mpi_errno; fn_fail: goto fn_exit; }