-: 0:Source:/home/MPI/testing/mpich2/mpich2/src/mpi/datatype/type_create_darray.c
-: 0:Graph:type_create_darray.gcno
-: 0:Data:type_create_darray.gcda
-: 0:Runs:531
-: 0:Programs:140
-: 1:/* -*- Mode: C; c-basic-offset:4 ; -*- */
-: 2:/*
-: 3: *
-: 4: * (C) 2001 by Argonne National Laboratory.
-: 5: * See COPYRIGHT in top-level directory.
-: 6: */
-: 7:
-: 8:#include "mpiimpl.h"
-: 9:
-: 10:/* -- Begin Profiling Symbol Block for routine MPI_Type_create_darray */
-: 11:#if defined(HAVE_PRAGMA_WEAK)
-: 12:#pragma weak MPI_Type_create_darray = PMPI_Type_create_darray
-: 13:#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
-: 14:#pragma _HP_SECONDARY_DEF PMPI_Type_create_darray MPI_Type_create_darray
-: 15:#elif defined(HAVE_PRAGMA_CRI_DUP)
-: 16:#pragma _CRI duplicate MPI_Type_create_darray as PMPI_Type_create_darray
-: 17:#endif
-: 18:/* -- End Profiling Symbol Block */
-: 19:
-: 20:#ifndef MIN
-: 21:#define MIN(__a, __b) (((__a) < (__b)) ? (__a) : (__b))
-: 22:#endif
-: 23:
-: 24:PMPI_LOCAL int MPIR_Type_block(int *array_of_gsizes,
-: 25: int dim,
-: 26: int ndims,
-: 27: int nprocs,
-: 28: int rank,
-: 29: int darg,
-: 30: int order,
-: 31: MPI_Aint orig_extent,
-: 32: MPI_Datatype type_old,
-: 33: MPI_Datatype *type_new,
-: 34: MPI_Aint *st_offset);
-: 35:PMPI_LOCAL int MPIR_Type_cyclic(int *array_of_gsizes,
-: 36: int dim,
-: 37: int ndims,
-: 38: int nprocs,
-: 39: int rank,
-: 40: int darg,
-: 41: int order,
-: 42: MPI_Aint orig_extent,
-: 43: MPI_Datatype type_old,
-: 44: MPI_Datatype *type_new,
-: 45: MPI_Aint *st_offset);
-: 46:
-: 47:/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
-: 48: the MPI routines */
-: 49:#ifndef MPICH_MPI_FROM_PMPI
-: 50:#undef MPI_Type_create_darray
-: 51:#define MPI_Type_create_darray PMPI_Type_create_darray
-: 52:
-: 53:
-: 54:
-: 55:PMPI_LOCAL int MPIR_Type_block(int *array_of_gsizes,
-: 56: int dim,
-: 57: int ndims,
-: 58: int nprocs,
-: 59: int rank,
-: 60: int darg,
-: 61: int order,
-: 62: MPI_Aint orig_extent,
-: 63: MPI_Datatype type_old,
-: 64: MPI_Datatype *type_new,
-: 65: MPI_Aint *st_offset)
940: 66:{
-: 67:/* nprocs = no. of processes in dimension dim of grid
-: 68: rank = coordinate of this process in dimension dim */
-: 69: static const char FCNAME[] = "MPIR_Type_block";
-: 70: int mpi_errno, blksize, global_size, mysize, i, j;
-: 71: MPI_Aint stride;
-: 72:
940: 73: global_size = array_of_gsizes[dim];
-: 74:
940: 75: if (darg == MPI_DISTRIBUTE_DFLT_DARG)
940: 76: blksize = (global_size + nprocs - 1)/nprocs;
-: 77: else {
|
#####: 78: blksize = darg;
-: 79:
|
-: 80:#ifdef HAVE_ERROR_CHECKING
#####: 81: if (blksize <= 0) {
#####: 82: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 83: MPIR_ERR_RECOVERABLE,
-: 84: FCNAME,
-: 85: __LINE__,
-: 86: MPI_ERR_ARG,
-: 87: "**darrayblock",
-: 88: "**darrayblock %d",
-: 89: blksize);
#####: 90: return mpi_errno;
-: 91: }
#####: 92: if (blksize * nprocs < global_size) {
#####: 93: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 94: MPIR_ERR_RECOVERABLE,
-: 95: FCNAME,
-: 96: __LINE__,
-: 97: MPI_ERR_ARG,
-: 98: "**darrayblock2",
-: 99: "**darrayblock2 %d %d",
-: 100: blksize*nprocs,
-: 101: global_size);
#####: 102: return mpi_errno;
-: 103: }
-: 104:#endif
-: 105: }
-: 106:
|
940: 107: j = global_size - blksize*rank;
940: 108: mysize = MIN(blksize, j);
940: 109: if (mysize < 0) mysize = 0;
-: 110:
940: 111: stride = orig_extent;
940: 112: if (order == MPI_ORDER_FORTRAN) {
|
#####: 113: if (dim == 0) {
#####: 114: mpi_errno = MPID_Type_contiguous(mysize,
-: 115: type_old,
-: 116: type_new);
|
-: 117: /* --BEGIN ERROR HANDLING-- */
#####: 118: if (mpi_errno != MPI_SUCCESS)
-: 119: {
#####: 120: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 121: return mpi_errno;
-: 122: }
-: 123: /* --END ERROR HANDLING-- */
-: 124: }
-: 125: else {
|
#####: 126: for (i=0; i<dim; i++) stride *= (MPI_Aint)(array_of_gsizes[i]);
#####: 127: mpi_errno = MPID_Type_vector(mysize,
-: 128: 1,
-: 129: stride,
-: 130: 1, /* stride in bytes */
-: 131: type_old,
-: 132: type_new);
|
-: 133: /* --BEGIN ERROR HANDLING-- */
#####: 134: if (mpi_errno != MPI_SUCCESS)
-: 135: {
#####: 136: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 137: return mpi_errno;
-: 138: }
-: 139: /* --END ERROR HANDLING-- */
-: 140: }
-: 141: }
-: 142: else {
|
940: 143: if (dim == ndims-1) {
294: 144: mpi_errno = MPID_Type_contiguous(mysize,
-: 145: type_old,
-: 146: type_new);
|
-: 147: /* --BEGIN ERROR HANDLING-- */
294: 148: if (mpi_errno != MPI_SUCCESS)
-: 149: {
#####: 150: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 151: return mpi_errno;
-: 152: }
-: 153: /* --END ERROR HANDLING-- */
-: 154: }
-: 155: else {
|
646: 156: for (i=ndims-1; i>dim; i--) stride *= (MPI_Aint)(array_of_gsizes[i]);
646: 157: mpi_errno = MPID_Type_vector(mysize,
-: 158: 1,
-: 159: stride,
-: 160: 1, /* stride in bytes */
-: 161: type_old,
-: 162: type_new);
|
-: 163: /* --BEGIN ERROR HANDLING-- */
646: 164: if (mpi_errno != MPI_SUCCESS)
-: 165: {
#####: 166: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 167: return mpi_errno;
-: 168: }
-: 169: /* --END ERROR HANDLING-- */
-: 170: }
-: 171: }
-: 172:
|
940: 173: *st_offset = (MPI_Aint) blksize * (MPI_Aint) rank;
-: 174: /* in terms of no. of elements of type oldtype in this dimension */
940: 175: if (mysize == 0) *st_offset = 0;
-: 176:
940: 177: return MPI_SUCCESS;
-: 178:}
-: 179:
-: 180:
-: 181:PMPI_LOCAL int MPIR_Type_cyclic(int *array_of_gsizes,
-: 182: int dim,
-: 183: int ndims,
-: 184: int nprocs,
-: 185: int rank,
-: 186: int darg,
-: 187: int order,
-: 188: MPI_Aint orig_extent,
-: 189: MPI_Datatype type_old,
-: 190: MPI_Datatype *type_new,
-: 191: MPI_Aint *st_offset)
|
#####: 192:{
-: 193:/* nprocs = no. of processes in dimension dim of grid
-: 194: rank = coordinate of this process in dimension dim */
-: 195: static const char FCNAME[] = "MPIR_Type_cyclic";
-: 196: int mpi_errno,blksize, i, blklens[3], st_index, end_index,
-: 197: local_size, rem, count;
-: 198: MPI_Aint stride, disps[3];
-: 199: MPI_Datatype type_tmp, types[3];
#####: 200: MPIU_THREADPRIV_DECL;
-: 201:
#####: 202: MPIU_THREADPRIV_GET;
-: 203:
#####: 204: if (darg == MPI_DISTRIBUTE_DFLT_DARG) blksize = 1;
#####: 205: else blksize = darg;
-: 206:
|
-: 207:#ifdef HAVE_ERROR_CHECKING
#####: 208: if (blksize <= 0) {
#####: 209: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 210: MPIR_ERR_RECOVERABLE,
-: 211: FCNAME,
-: 212: __LINE__,
-: 213: MPI_ERR_ARG,
-: 214: "**darraycyclic",
-: 215: "**darraycyclic %d",
-: 216: blksize);
#####: 217: return mpi_errno;
-: 218: }
-: 219:#endif
-: 220:
|
#####: 221: st_index = rank*blksize;
#####: 222: end_index = array_of_gsizes[dim] - 1;
-: 223:
#####: 224: if (end_index < st_index) local_size = 0;
-: 225: else {
#####: 226: local_size = ((end_index - st_index + 1)/(nprocs*blksize))*blksize;
#####: 227: rem = (end_index - st_index + 1) % (nprocs*blksize);
#####: 228: local_size += MIN(rem, blksize);
-: 229: }
-: 230:
#####: 231: count = local_size/blksize;
#####: 232: rem = local_size % blksize;
-: 233:
#####: 234: stride = (MPI_Aint) nprocs * (MPI_Aint) blksize * orig_extent;
#####: 235: if (order == MPI_ORDER_FORTRAN)
#####: 236: for (i=0; i<dim; i++) stride *= (MPI_Aint)(array_of_gsizes[i]);
#####: 237: else for (i=ndims-1; i>dim; i--) stride *= (MPI_Aint)(array_of_gsizes[i]);
-: 238:
#####: 239: mpi_errno = MPID_Type_vector(count,
-: 240: blksize,
-: 241: stride,
-: 242: 1, /* stride in bytes */
-: 243: type_old,
-: 244: type_new);
|
-: 245: /* --BEGIN ERROR HANDLING-- */
#####: 246: if (mpi_errno != MPI_SUCCESS)
-: 247: {
#####: 248: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 249: return mpi_errno;
-: 250: }
-: 251: /* --END ERROR HANDLING-- */
-: 252:
|
#####: 253: if (rem) {
-: 254: /* if the last block is of size less than blksize, include
-: 255: it separately using MPI_Type_struct */
-: 256:
#####: 257: types[0] = *type_new;
#####: 258: types[1] = type_old;
#####: 259: disps[0] = 0;
#####: 260: disps[1] = (MPI_Aint) count * stride;
#####: 261: blklens[0] = 1;
#####: 262: blklens[1] = rem;
-: 263:
#####: 264: mpi_errno = MPID_Type_struct(2,
-: 265: blklens,
-: 266: disps,
-: 267: types,
-: 268: &type_tmp);
#####: 269: MPIR_Nest_incr();
#####: 270: NMPI_Type_free(type_new);
#####: 271: MPIR_Nest_decr();
#####: 272: *type_new = type_tmp;
-: 273:
|
-: 274: /* --BEGIN ERROR HANDLING-- */
#####: 275: if (mpi_errno != MPI_SUCCESS)
-: 276: {
#####: 277: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 278: return mpi_errno;
-: 279: }
-: 280: /* --END ERROR HANDLING-- */
-: 281: }
-: 282:
-: 283: /* In the first iteration, we need to set the displacement in that
-: 284: dimension correctly. */
|
#####: 285: if (((order == MPI_ORDER_FORTRAN) && (dim == 0)) ||
-: 286: ((order == MPI_ORDER_C) && (dim == ndims-1)))
-: 287: {
#####: 288: types[0] = MPI_LB;
#####: 289: disps[0] = 0;
#####: 290: types[1] = *type_new;
#####: 291: disps[1] = (MPI_Aint) rank * (MPI_Aint) blksize * orig_extent;
#####: 292: types[2] = MPI_UB;
#####: 293: disps[2] = orig_extent * (MPI_Aint)(array_of_gsizes[dim]);
#####: 294: blklens[0] = blklens[1] = blklens[2] = 1;
#####: 295: mpi_errno = MPID_Type_struct(3,
-: 296: blklens,
-: 297: disps,
-: 298: types,
-: 299: &type_tmp);
#####: 300: MPIR_Nest_incr();
#####: 301: NMPI_Type_free(type_new);
#####: 302: MPIR_Nest_decr();
#####: 303: *type_new = type_tmp;
-: 304:
|
-: 305: /* --BEGIN ERROR HANDLING-- */
#####: 306: if (mpi_errno != MPI_SUCCESS)
-: 307: {
#####: 308: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 309: return mpi_errno;
-: 310: }
-: 311: /* --END ERROR HANDLING-- */
-: 312:
|
#####: 313: *st_offset = 0; /* set it to 0 because it is taken care of in
-: 314: the struct above */
-: 315: }
-: 316: else {
#####: 317: *st_offset = (MPI_Aint) rank * (MPI_Aint) blksize;
-: 318: /* st_offset is in terms of no. of elements of type oldtype in
-: 319: * this dimension */
-: 320: }
-: 321:
#####: 322: if (local_size == 0) *st_offset = 0;
-: 323:
#####: 324: return MPI_SUCCESS;
-: 325:}
-: 326:#endif
-: 327:
-: 328:#undef FUNCNAME
-: 329:#define FUNCNAME MPI_Type_create_darray
-: 330:
-: 331:
-: 332:/*@
-: 333: MPI_Type_create_darray - Create a datatype representing a distributed array
-: 334:
-: 335: Input Parameters:
-: 336:+ size - size of process group (positive integer)
-: 337:. rank - rank in process group (nonnegative integer)
-: 338:. ndims - number of array dimensions as well as process grid dimensions (positive integer)
-: 339:. array_of_gsizes - number of elements of type oldtype in each dimension of global array (array of positive integers)
-: 340:. array_of_distribs - distribution of array in each dimension (array of state)
-: 341:. array_of_dargs - distribution argument in each dimension (array of positive integers)
-: 342:. array_of_psizes - size of process grid in each dimension (array of positive integers)
-: 343:. order - array storage order flag (state)
-: 344:- oldtype - old datatype (handle)
-: 345:
-: 346: Output Parameter:
-: 347:. newtype - new datatype (handle)
-: 348:
-: 349:.N ThreadSafe
-: 350:
-: 351:.N Fortran
-: 352:
-: 353:.N Errors
-: 354:.N MPI_SUCCESS
-: 355:.N MPI_ERR_TYPE
-: 356:.N MPI_ERR_ARG
-: 357:@*/
-: 358:int MPI_Type_create_darray(int size,
-: 359: int rank,
-: 360: int ndims,
-: 361: int array_of_gsizes[],
-: 362: int array_of_distribs[],
-: 363: int array_of_dargs[],
-: 364: int array_of_psizes[],
-: 365: int order,
-: 366: MPI_Datatype oldtype,
-: 367: MPI_Datatype *newtype)
|
294: 368:{
-: 369: static const char FCNAME[] = "MPI_Type_create_darray";
294: 370: int mpi_errno = MPI_SUCCESS, i;
-: 371:
-: 372: int procs, tmp_rank, tmp_size, blklens[3], *coords;
-: 373: MPI_Aint *st_offsets, orig_extent, disps[3];
294: 374: MPI_Datatype type_old, type_new = MPI_DATATYPE_NULL, types[3];
-: 375:
|
-: 376:# ifdef HAVE_ERROR_CHECKING
-: 377: MPI_Aint size_with_aint;
-: 378: MPI_Offset size_with_offset;
-: 379:# endif
-: 380:
-: 381: int *ints;
|
294: 382: MPID_Datatype *datatype_ptr = NULL;
294: 383: MPIU_THREADPRIV_DECL;
294: 384: MPIU_CHKLMEM_DECL(3);
-: 385: MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_CREATE_DARRAY);
-: 386:
294: 387: MPIR_ERRTEST_INITIALIZED_ORDIE();
-: 388:
294: 389: MPIU_THREAD_CS_ENTER(ALLFUNC,);
-: 390: MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_CREATE_DARRAY);
-: 391:
294: 392: MPIU_THREADPRIV_GET;
-: 393:
-: 394: /* Validate parameters, especially handles needing to be converted */
|
-: 395:# ifdef HAVE_ERROR_CHECKING
-: 396: {
-: 397: MPID_BEGIN_ERROR_CHECKS;
-: 398: {
294: 399: MPIR_ERRTEST_DATATYPE(oldtype, "datatype", mpi_errno);
294: 400: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 401: }
-: 402: MPID_END_ERROR_CHECKS;
-: 403: }
-: 404:# endif
-: 405:
-: 406: /* Convert MPI object handles to object pointers */
|
294: 407: MPID_Datatype_get_ptr(oldtype, datatype_ptr);
294: 408: MPID_Datatype_get_extent_macro(oldtype, orig_extent);
-: 409:
-: 410: /* Validate parameters and objects (post conversion) */
|
-: 411:# ifdef HAVE_ERROR_CHECKING
-: 412: {
-: 413: MPID_BEGIN_ERROR_CHECKS;
-: 414: {
-: 415: /* Check parameters */
294: 416: MPIR_ERRTEST_ARGNEG(rank, "rank", mpi_errno);
294: 417: MPIR_ERRTEST_ARGNONPOS(size, "size", mpi_errno);
294: 418: MPIR_ERRTEST_ARGNONPOS(ndims, "ndims", mpi_errno);
-: 419:
294: 420: MPIR_ERRTEST_ARGNULL(array_of_gsizes, "array_of_gsizes", mpi_errno);
294: 421: MPIR_ERRTEST_ARGNULL(array_of_distribs, "array_of_distribs", mpi_errno);
294: 422: MPIR_ERRTEST_ARGNULL(array_of_dargs, "array_of_dargs", mpi_errno);
294: 423: MPIR_ERRTEST_ARGNULL(array_of_psizes, "array_of_psizes", mpi_errno);
294: 424: if (order != MPI_ORDER_C && order != MPI_ORDER_FORTRAN) {
#####: 425: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 426: MPIR_ERR_RECOVERABLE,
-: 427: FCNAME,
-: 428: __LINE__,
-: 429: MPI_ERR_ARG,
-: 430: "**arg",
-: 431: "**arg %s",
-: 432: "order");
-: 433: }
-: 434:
1234: 435: for (i=0; mpi_errno == MPI_SUCCESS && i < ndims; i++) {
940: 436: MPIR_ERRTEST_ARGNONPOS(array_of_gsizes[i], "gsize", mpi_errno);
940: 437: MPIR_ERRTEST_ARGNONPOS(array_of_psizes[i], "psize", mpi_errno);
-: 438:
940: 439: if ((array_of_distribs[i] != MPI_DISTRIBUTE_NONE) &&
-: 440: (array_of_distribs[i] != MPI_DISTRIBUTE_BLOCK) &&
-: 441: (array_of_distribs[i] != MPI_DISTRIBUTE_CYCLIC))
-: 442: {
#####: 443: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 444: MPIR_ERR_RECOVERABLE,
-: 445: FCNAME,
-: 446: __LINE__,
-: 447: MPI_ERR_ARG,
-: 448: "**darrayunknown",
-: 449: 0);
-: 450: }
-: 451:
940: 452: if ((array_of_dargs[i] != MPI_DISTRIBUTE_DFLT_DARG) &&
-: 453: (array_of_dargs[i] <= 0))
-: 454: {
#####: 455: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 456: MPIR_ERR_RECOVERABLE,
-: 457: FCNAME,
-: 458: __LINE__,
-: 459: MPI_ERR_ARG,
-: 460: "**arg",
-: 461: "**arg %s",
-: 462: "array_of_dargs");
-: 463: }
-: 464:
940: 465: if ((array_of_distribs[i] == MPI_DISTRIBUTE_NONE) &&
-: 466: (array_of_psizes[i] != 1))
-: 467: {
#####: 468: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 469: MPIR_ERR_RECOVERABLE,
-: 470: FCNAME,
-: 471: __LINE__,
-: 472: MPI_ERR_ARG,
-: 473: "**darraydist",
-: 474: "**darraydist %d %d",
-: 475: i, array_of_psizes[i]);
-: 476: }
-: 477: }
-: 478:
-: 479: /* TODO: GET THIS CHECK IN ALSO */
-: 480:
-: 481: /* check if MPI_Aint is large enough for size of global array.
-: 482: if not, complain. */
-: 483:
294: 484: size_with_aint = orig_extent;
294: 485: for (i=0; i<ndims; i++) size_with_aint *= array_of_gsizes[i];
294: 486: size_with_offset = orig_extent;
294: 487: for (i=0; i<ndims; i++) size_with_offset *= array_of_gsizes[i];
294: 488: if (size_with_aint != size_with_offset) {
#####: 489: mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
-: 490: MPIR_ERR_FATAL,
-: 491: FCNAME,
-: 492: __LINE__,
-: 493: MPI_ERR_ARG,
-: 494: "**darrayoverflow",
-: 495: "**darrayoverflow %L",
-: 496: size_with_offset);
-: 497: }
-: 498:
-: 499: /* Validate datatype_ptr */
294: 500: MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
-: 501: /* If datatype_ptr is not valid, it will be reset to null */
-: 502: /* --BEGIN ERROR HANDLING-- */
294: 503: if (mpi_errno) goto fn_fail;
-: 504: /* --END ERROR HANDLING-- */
-: 505: }
-: 506: MPID_END_ERROR_CHECKS;
-: 507: }
-: 508:# endif /* HAVE_ERROR_CHECKING */
-: 509:
-: 510: /* ... body of routine ... */
-: 511:
-: 512:/* calculate position in Cartesian grid as MPI would (row-major
-: 513: ordering) */
|
294: 514: MPIU_CHKLMEM_MALLOC_ORJUMP(coords, int *, ndims * sizeof(int), mpi_errno, "position is Cartesian grid");
-: 515:
294: 516: procs = size;
294: 517: tmp_rank = rank;
1234: 518: for (i=0; i<ndims; i++) {
940: 519: procs = procs/array_of_psizes[i];
940: 520: coords[i] = tmp_rank/procs;
940: 521: tmp_rank = tmp_rank % procs;
-: 522: }
-: 523:
294: 524: MPIU_CHKLMEM_MALLOC_ORJUMP(st_offsets, MPI_Aint *, ndims * sizeof(MPI_Aint), mpi_errno, "st_offsets");
-: 525:
294: 526: type_old = oldtype;
-: 527:
294: 528: if (order == MPI_ORDER_FORTRAN) {
-: 529: /* dimension 0 changes fastest */
|
#####: 530: for (i=0; i<ndims; i++) {
#####: 531: switch(array_of_distribs[i]) {
-: 532: case MPI_DISTRIBUTE_BLOCK:
#####: 533: mpi_errno = MPIR_Type_block(array_of_gsizes,
-: 534: i,
-: 535: ndims,
-: 536: array_of_psizes[i],
-: 537: coords[i],
-: 538: array_of_dargs[i],
-: 539: order,
-: 540: orig_extent,
-: 541: type_old,
-: 542: &type_new,
-: 543: st_offsets+i);
#####: 544: break;
-: 545: case MPI_DISTRIBUTE_CYCLIC:
#####: 546: mpi_errno = MPIR_Type_cyclic(array_of_gsizes,
-: 547: i,
-: 548: ndims,
-: 549: array_of_psizes[i],
-: 550: coords[i],
-: 551: array_of_dargs[i],
-: 552: order,
-: 553: orig_extent,
-: 554: type_old,
-: 555: &type_new,
-: 556: st_offsets+i);
#####: 557: break;
-: 558: case MPI_DISTRIBUTE_NONE:
-: 559: /* treat it as a block distribution on 1 process */
#####: 560: mpi_errno = MPIR_Type_block(array_of_gsizes,
-: 561: i,
-: 562: ndims,
-: 563: 1,
-: 564: 0,
-: 565: MPI_DISTRIBUTE_DFLT_DARG,
-: 566: order,
-: 567: orig_extent,
-: 568: type_old,
-: 569: &type_new,
-: 570: st_offsets+i);
-: 571: break;
-: 572: }
#####: 573: if (i)
-: 574: {
#####: 575: MPIR_Nest_incr();
#####: 576: NMPI_Type_free(&type_old);
#####: 577: MPIR_Nest_decr();
-: 578: }
#####: 579: type_old = type_new;
-: 580:
|
-: 581: /* --BEGIN ERROR HANDLING-- */
#####: 582: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 583: /* --END ERROR HANDLING-- */
-: 584: }
-: 585:
-: 586: /* add displacement and UB */
|
#####: 587: disps[1] = st_offsets[0];
#####: 588: tmp_size = 1;
#####: 589: for (i=1; i<ndims; i++) {
#####: 590: tmp_size *= array_of_gsizes[i-1];
#####: 591: disps[1] += (MPI_Aint) tmp_size * st_offsets[i];
-: 592: }
-: 593: /* rest done below for both Fortran and C order */
-: 594: }
-: 595:
-: 596: else /* order == MPI_ORDER_C */ {
-: 597: /* dimension ndims-1 changes fastest */
|
1234: 598: for (i=ndims-1; i>=0; i--) {
940: 599: switch(array_of_distribs[i]) {
-: 600: case MPI_DISTRIBUTE_BLOCK:
580: 601: mpi_errno = MPIR_Type_block(array_of_gsizes,
-: 602: i,
-: 603: ndims,
-: 604: array_of_psizes[i],
-: 605: coords[i],
-: 606: array_of_dargs[i],
-: 607: order,
-: 608: orig_extent,
-: 609: type_old,
-: 610: &type_new,
-: 611: st_offsets+i);
580: 612: break;
-: 613: case MPI_DISTRIBUTE_CYCLIC:
|
#####: 614: mpi_errno = MPIR_Type_cyclic(array_of_gsizes,
-: 615: i,
-: 616: ndims,
-: 617: array_of_psizes[i],
-: 618: coords[i],
-: 619: array_of_dargs[i],
-: 620: order,
-: 621: orig_extent,
-: 622: type_old,
-: 623: &type_new,
-: 624: st_offsets+i);
#####: 625: break;
-: 626: case MPI_DISTRIBUTE_NONE:
-: 627: /* treat it as a block distribution on 1 process */
|
360: 628: mpi_errno = MPIR_Type_block(array_of_gsizes,
-: 629: i,
-: 630: ndims,
-: 631: array_of_psizes[i],
-: 632: coords[i],
-: 633: MPI_DISTRIBUTE_DFLT_DARG,
-: 634: order,
-: 635: orig_extent,
-: 636: type_old,
-: 637: &type_new,
-: 638: st_offsets+i);
-: 639: break;
-: 640: }
940: 641: if (i != ndims-1)
-: 642: {
646: 643: MPIR_Nest_incr();
646: 644: NMPI_Type_free(&type_old);
646: 645: MPIR_Nest_decr();
-: 646: }
940: 647: type_old = type_new;
-: 648:
|
-: 649: /* --BEGIN ERROR HANDLING-- */
940: 650: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 651: /* --END ERROR HANDLING-- */
-: 652: }
-: 653:
-: 654: /* add displacement and UB */
|
294: 655: disps[1] = st_offsets[ndims-1];
294: 656: tmp_size = 1;
940: 657: for (i=ndims-2; i>=0; i--) {
646: 658: tmp_size *= array_of_gsizes[i+1];
646: 659: disps[1] += (MPI_Aint) tmp_size * st_offsets[i];
-: 660: }
-: 661: }
-: 662:
294: 663: disps[1] *= orig_extent;
-: 664:
294: 665: disps[2] = orig_extent;
294: 666: for (i=0; i<ndims; i++) disps[2] *= (MPI_Aint)(array_of_gsizes[i]);
-: 667:
294: 668: disps[0] = 0;
294: 669: blklens[0] = blklens[1] = blklens[2] = 1;
294: 670: types[0] = MPI_LB;
294: 671: types[1] = type_new;
294: 672: types[2] = MPI_UB;
-: 673:
294: 674: mpi_errno = MPID_Type_struct(3,
-: 675: blklens,
-: 676: disps,
-: 677: types,
-: 678: newtype);
|
-: 679: /* --BEGIN ERROR HANDLING-- */
294: 680: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 681: /* --END ERROR HANDLING-- */
-: 682:
|
294: 683: MPIR_Nest_incr();
294: 684: NMPI_Type_free(&type_new);
294: 685: MPIR_Nest_decr();
-: 686:
-: 687: /* at this point we have the new type, and we've cleaned up any
-: 688: * intermediate types created in the process. we just need to save
-: 689: * all our contents/envelope information.
-: 690: */
-: 691:
-: 692: /* Save contents */
294: 693: MPIU_CHKLMEM_MALLOC_ORJUMP(ints, int *, (4 * ndims + 4) * sizeof(int), mpi_errno, "content description");
-: 694:
294: 695: ints[0] = size;
294: 696: ints[1] = rank;
294: 697: ints[2] = ndims;
-: 698:
1234: 699: for (i=0; i < ndims; i++) {
940: 700: ints[i + 3] = array_of_gsizes[i];
-: 701: }
1234: 702: for (i=0; i < ndims; i++) {
940: 703: ints[i + ndims + 3] = array_of_distribs[i];
-: 704: }
1234: 705: for (i=0; i < ndims; i++) {
940: 706: ints[i + 2*ndims + 3] = array_of_dargs[i];
-: 707: }
1234: 708: for (i=0; i < ndims; i++) {
940: 709: ints[i + 3*ndims + 3] = array_of_psizes[i];
-: 710: }
294: 711: ints[4*ndims + 3] = order;
294: 712: MPID_Datatype_get_ptr(*newtype, datatype_ptr);
294: 713: mpi_errno = MPID_Datatype_set_contents(datatype_ptr,
-: 714: MPI_COMBINER_DARRAY,
-: 715: 4*ndims + 4,
-: 716: 0,
-: 717: 1,
-: 718: ints,
-: 719: NULL,
-: 720: &oldtype);
|
-: 721: /* --BEGIN ERROR HANDLING-- */
294: 722: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 723: /* --END ERROR HANDLING-- */
-: 724:
-: 725: /* ... end of body of routine ... */
-: 726:
-: 727: fn_exit:
|
882: 728: MPIU_CHKLMEM_FREEALL();
|
-: 729: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_CREATE_DARRAY);
|
294: 730: MPIU_THREAD_CS_EXIT(ALLFUNC,);
294: 731: return mpi_errno;
-: 732:
|
#####: 733: fn_fail:
-: 734: /* --BEGIN ERROR HANDLING-- */
-: 735:# ifdef HAVE_ERROR_CHECKING
-: 736: {
#####: 737: mpi_errno = MPIR_Err_create_code(
-: 738: mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_type_create_darray",
-: 739: "**mpi_type_create_darray %d %d %d %p %p %p %p %d %D %p", size, rank, ndims, array_of_gsizes,
-: 740: array_of_distribs, array_of_dargs, array_of_psizes, order, oldtype, newtype);
-: 741: }
-: 742:# endif
#####: 743: mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
#####: 744: goto fn_exit;
-: 745: /* --END ERROR HANDLING-- */
-: 746:}
|