-: 0:Source:/home/MPI/testing/mpich2/mpich2/src/mpi/coll/gather.c
-: 0:Graph:gather.gcno
-: 0:Data:gather.gcda
-: 0:Runs:4009
-: 0:Programs:1234
-: 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_Gather */
-: 11:#if defined(HAVE_PRAGMA_WEAK)
-: 12:#pragma weak MPI_Gather = PMPI_Gather
-: 13:#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
-: 14:#pragma _HP_SECONDARY_DEF PMPI_Gather MPI_Gather
-: 15:#elif defined(HAVE_PRAGMA_CRI_DUP)
-: 16:#pragma _CRI duplicate MPI_Gather as PMPI_Gather
-: 17:#endif
-: 18:/* -- End Profiling Symbol Block */
-: 19:
-: 20:/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
-: 21: the MPI routines */
-: 22:#ifndef MPICH_MPI_FROM_PMPI
-: 23:#undef MPI_Gather
-: 24:#define MPI_Gather PMPI_Gather
-: 25:/* This is the default implementation of gather. The algorithm is:
-: 26:
-: 27: Algorithm: MPI_Gather
-: 28:
-: 29: We use a binomial tree algorithm for both short and long
-: 30: messages. At nodes other than leaf nodes we need to allocate a
-: 31: temporary buffer to store the incoming message. If the root is not
-: 32: rank 0, for very small messages, we pack it into a temporary
-: 33: contiguous buffer and reorder it to be placed in the right
-: 34: order. For small (but not very small) messages, we use a derived
-: 35: datatype to unpack the incoming data into non-contiguous buffers in
-: 36: the right order. In the heterogeneous case we first pack the
-: 37: buffers by using MPI_Pack and then do the gather.
-: 38:
-: 39: Cost = lgp.alpha + n.((p-1)/p).beta
-: 40: where n is the total size of the data gathered at the root.
-: 41:
-: 42: Possible improvements:
-: 43:
-: 44: End Algorithm: MPI_Gather
-: 45:*/
-: 46:
-: 47:/* not declared static because it is called in intercomm. allgather */
-: 48:/* begin:nested */
-: 49:int MPIR_Gather (
-: 50: void *sendbuf,
-: 51: int sendcnt,
-: 52: MPI_Datatype sendtype,
-: 53: void *recvbuf,
-: 54: int recvcnt,
-: 55: MPI_Datatype recvtype,
-: 56: int root,
-: 57: MPID_Comm *comm_ptr )
17841: 58:{
-: 59: static const char FCNAME[] = "MPIR_Gather";
-: 60: int comm_size, rank;
17841: 61: int mpi_errno = MPI_SUCCESS;
17841: 62: int curr_cnt=0, relative_rank, nbytes, is_homogeneous;
-: 63: int mask, sendtype_size, recvtype_size, src, dst, relative_src;
-: 64: int recvblks;
-: 65: int tmp_buf_size, missing;
17841: 66: void *tmp_buf=NULL;
-: 67: MPI_Status status;
17841: 68: MPI_Aint extent=0; /* Datatype extent */
-: 69: MPI_Comm comm;
-: 70: int blocks[2];
-: 71: int displs[2];
-: 72: MPI_Aint struct_displs[2];
-: 73: MPI_Datatype types[2], tmp_type;
17841: 74: int copy_offset = 0, copy_blks = 0;
-: 75:
-: 76:#ifdef MPID_HAS_HETERO
-: 77: int position, recv_size;
-: 78:#endif
-: 79:
17841: 80: comm = comm_ptr->handle;
17841: 81: comm_size = comm_ptr->local_size;
17841: 82: rank = comm_ptr->rank;
-: 83:
17841: 84: if ( ((rank == root) && (recvcnt == 0)) ||
-: 85: ((rank != root) && (sendcnt == 0)) )
344: 86: return MPI_SUCCESS;
-: 87:
17497: 88: is_homogeneous = 1;
-: 89:#ifdef MPID_HAS_HETERO
-: 90: if (comm_ptr->is_hetero)
-: 91: is_homogeneous = 0;
-: 92:#endif
-: 93:
-: 94: /* check if multiple threads are calling this collective function */
-: 95: MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );
-: 96:
-: 97: /* Use binomial tree algorithm. */
-: 98:
17497: 99: relative_rank = (rank >= root) ? rank - root : rank - root + comm_size;
-: 100:
17497: 101: if (rank == root)
-: 102: {
6136: 103: MPID_Datatype_get_extent_macro(recvtype, extent);
-: 104: MPID_Ensure_Aint_fits_in_pointer(MPI_VOID_PTR_CAST_TO_MPI_AINT recvbuf+
-: 105: (extent*recvcnt*comm_size));
-: 106: }
-: 107:
17497: 108: if (is_homogeneous)
-: 109: {
-: 110:
-: 111: /* communicator is homogeneous. no need to pack buffer. */
-: 112:
17497: 113: if (rank == root)
-: 114: {
6136: 115: MPID_Datatype_get_size_macro(recvtype, recvtype_size);
6136: 116: nbytes = recvtype_size * recvcnt;
-: 117: }
-: 118: else
-: 119: {
11361: 120: MPID_Datatype_get_size_macro(sendtype, sendtype_size);
11361: 121: nbytes = sendtype_size * sendcnt;
-: 122: }
-: 123:
-: 124: /* Find the number of missing nodes in my sub-tree compared to
-: 125: * a balanced tree */
17497: 126: for (mask = 1; mask < comm_size; mask <<= 1);
17497: 127: --mask;
17497: 128: while (relative_rank & mask) mask >>= 1;
17497: 129: missing = (relative_rank | mask) - comm_size + 1;
17497: 130: if (missing < 0) missing = 0;
17497: 131: tmp_buf_size = (mask - missing);
-: 132:
-: 133: /* If the message is smaller than the threshold, we will copy
-: 134: * our message in there too */
17497: 135: if (nbytes < MPIR_GATHER_VSMALL_MSG) tmp_buf_size++;
-: 136:
17497: 137: tmp_buf_size *= nbytes;
-: 138:
-: 139: /* For zero-ranked root, we don't need any temporary buffer */
17497: 140: if ((rank == root) && (!root || (nbytes >= MPIR_GATHER_VSMALL_MSG)))
5166: 141: tmp_buf_size = 0;
-: 142:
17497: 143: if (tmp_buf_size) {
7359: 144: tmp_buf = MPIU_Malloc(tmp_buf_size);
|
-: 145: /* --BEGIN ERROR HANDLING-- */
7359: 146: if (!tmp_buf)
-: 147: {
#####: 148: mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**nomem", 0 );
#####: 149: return mpi_errno;
-: 150: }
-: 151: /* --END ERROR HANDLING-- */
-: 152: }
-: 153:
|
17497: 154: if (rank == root)
-: 155: {
6136: 156: if (sendbuf != MPI_IN_PLACE)
-: 157: {
5817: 158: mpi_errno = MPIR_Localcopy(sendbuf, sendcnt, sendtype,
-: 159: ((char *) recvbuf + extent*recvcnt*rank), recvcnt, recvtype);
|
5817: 160: if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
-: 161: }
-: 162: }
|
11361: 163: else if (tmp_buf_size && (nbytes < MPIR_GATHER_VSMALL_MSG))
-: 164: {
-: 165: /* copy from sendbuf into tmp_buf */
4244: 166: mpi_errno = MPIR_Localcopy(sendbuf, sendcnt, sendtype,
-: 167: tmp_buf, nbytes, MPI_BYTE);
|
4244: 168: if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
-: 169: }
|
17497: 170: curr_cnt = nbytes;
-: 171:
17497: 172: mask = 0x1;
47031: 173: while (mask < comm_size)
-: 174: {
23398: 175: if ((mask & relative_rank) == 0)
-: 176: {
12037: 177: src = relative_rank | mask;
12037: 178: if (src < comm_size)
-: 179: {
11361: 180: src = (src + root) % comm_size;
-: 181:
11361: 182: if (rank == root)
-: 183: {
8485: 184: recvblks = mask;
8485: 185: if ((2 * recvblks) > comm_size)
625: 186: recvblks = comm_size - recvblks;
-: 187:
15869: 188: if ((rank + mask + recvblks == comm_size) ||
-: 189: (((rank + mask) % comm_size) <
-: 190: ((rank + mask + recvblks) % comm_size))) {
-: 191: /* If the data contiguously fits into the
-: 192: * receive buffer, place it directly. This
-: 193: * should cover the case where the root is
-: 194: * rank 0. */
7384: 195: mpi_errno = MPIC_Recv(((char *)recvbuf +
-: 196: (((rank + mask) % comm_size)*recvcnt*extent)),
-: 197: recvblks * recvcnt, recvtype, src,
-: 198: MPIR_GATHER_TAG, comm,
-: 199: &status);
-: 200: }
1101: 201: else if (nbytes < MPIR_GATHER_VSMALL_MSG) {
101: 202: mpi_errno = MPIC_Recv(tmp_buf, recvblks * nbytes, MPI_BYTE,
-: 203: src, MPIR_GATHER_TAG, comm, &status);
101: 204: copy_offset = rank + mask;
101: 205: copy_blks = recvblks;
-: 206: }
-: 207: else {
1000: 208: blocks[0] = recvcnt * (comm_size - root - mask);
1000: 209: displs[0] = recvcnt * (root + mask);
1000: 210: blocks[1] = (recvcnt * recvblks) - blocks[0];
1000: 211: displs[1] = 0;
-: 212:
1000: 213: NMPI_Type_indexed(2, blocks, displs, recvtype, &tmp_type);
1000: 214: NMPI_Type_commit(&tmp_type);
-: 215:
1000: 216: mpi_errno = MPIC_Recv(recvbuf, 1, tmp_type, src,
-: 217: MPIR_GATHER_TAG, comm, &status);
-: 218:
1000: 219: NMPI_Type_free(&tmp_type);
-: 220: }
-: 221: }
-: 222: else /* Intermediate nodes store in temporary buffer */
-: 223: {
-: 224: int offset;
-: 225:
-: 226: /* Estimate the amount of data that is going to come in */
2876: 227: recvblks = mask;
2876: 228: relative_src = ((src - root) < 0) ? (src - root + comm_size) : (src - root);
2876: 229: if (relative_src + mask > comm_size)
5: 230: recvblks -= (relative_src + mask - comm_size);
-: 231:
2876: 232: if (nbytes < MPIR_GATHER_VSMALL_MSG)
731: 233: offset = mask * nbytes;
-: 234: else
2145: 235: offset = (mask - 1) * nbytes;
2876: 236: mpi_errno = MPIC_Recv(((char *)tmp_buf + offset),
-: 237: recvblks * nbytes, MPI_BYTE, src,
-: 238: MPIR_GATHER_TAG, comm,
-: 239: &status);
2876: 240: curr_cnt += (recvblks * nbytes);
-: 241: }
|
11361: 242: if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
-: 243: }
-: 244: }
-: 245: else
-: 246: {
|
11361: 247: dst = relative_rank ^ mask;
11361: 248: dst = (dst + root) % comm_size;
-: 249:
11361: 250: if (!tmp_buf_size)
-: 251: {
-: 252: /* leaf nodes send directly from sendbuf */
4972: 253: mpi_errno = MPIC_Send(sendbuf, sendcnt, sendtype, dst,
-: 254: MPIR_GATHER_TAG, comm);
-: 255: }
6389: 256: else if (nbytes < MPIR_GATHER_VSMALL_MSG) {
4244: 257: mpi_errno = MPIC_Send(tmp_buf, curr_cnt, MPI_BYTE, dst,
-: 258: MPIR_GATHER_TAG, comm);
-: 259: }
-: 260: else {
2145: 261: blocks[0] = sendcnt;
2145: 262: struct_displs[0] = MPI_VOID_PTR_CAST_TO_MPI_AINT sendbuf;
2145: 263: types[0] = sendtype;
2145: 264: blocks[1] = curr_cnt - nbytes;
2145: 265: struct_displs[1] = MPI_VOID_PTR_CAST_TO_MPI_AINT tmp_buf;
2145: 266: types[1] = MPI_BYTE;
-: 267:
2145: 268: NMPI_Type_create_struct(2, blocks, struct_displs, types, &tmp_type);
2145: 269: NMPI_Type_commit(&tmp_type);
-: 270:
2145: 271: mpi_errno = MPIC_Send(MPI_BOTTOM, 1, tmp_type, dst,
-: 272: MPIR_GATHER_TAG, comm);
-: 273:
2145: 274: NMPI_Type_free(&tmp_type);
-: 275: }
|
11361: 276: if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
-: 277:
-: 278: break;
-: 279: }
|
12037: 280: mask <<= 1;
-: 281: }
-: 282:
17497: 283: if ((rank == root) && root && (nbytes < MPIR_GATHER_VSMALL_MSG) && copy_blks)
-: 284: {
-: 285: /* reorder and copy from tmp_buf into recvbuf */
101: 286: MPIR_Localcopy(tmp_buf,
-: 287: nbytes * (comm_size - copy_offset), MPI_BYTE,
-: 288: ((char *) recvbuf + extent * recvcnt * copy_offset),
-: 289: recvcnt * (comm_size - copy_offset), recvtype);
101: 290: MPIR_Localcopy((char *) tmp_buf + nbytes * (comm_size - copy_offset),
-: 291: nbytes * (copy_blks - comm_size + copy_offset), MPI_BYTE,
-: 292: recvbuf,
-: 293: recvcnt * (copy_blks - comm_size + copy_offset), recvtype);
-: 294: }
-: 295:
17497: 296: if (tmp_buf) MPIU_Free(tmp_buf);
-: 297: }
-: 298:
-: 299:#ifdef MPID_HAS_HETERO
-: 300: else
-: 301: { /* communicator is heterogeneous. pack data into tmp_buf. */
-: 302: if (rank == root)
-: 303: NMPI_Pack_size(recvcnt*comm_size, recvtype, comm,
-: 304: &tmp_buf_size);
-: 305: else
-: 306: NMPI_Pack_size(sendcnt*(comm_size/2), sendtype, comm,
-: 307: &tmp_buf_size);
-: 308:
-: 309: tmp_buf = MPIU_Malloc(tmp_buf_size);
|
-: 310: /* --BEGIN ERROR HANDLING-- */
-: 311: if (!tmp_buf)
-: 312: {
-: 313: mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**nomem", 0 );
-: 314: return mpi_errno;
-: 315: }
-: 316: /* --END ERROR HANDLING-- */
-: 317:
-: 318: position = 0;
-: 319: if (sendbuf != MPI_IN_PLACE)
-: 320: {
-: 321: NMPI_Pack(sendbuf, sendcnt, sendtype, tmp_buf,
-: 322: tmp_buf_size, &position, comm);
-: 323: nbytes = position;
-: 324: }
-: 325: else
-: 326: {
-: 327: /* do a dummy pack just to calculate nbytes */
-: 328: NMPI_Pack(recvbuf, 1, recvtype, tmp_buf,
-: 329: tmp_buf_size, &position, comm);
-: 330: nbytes = position*recvcnt;
-: 331: }
-: 332:
-: 333: curr_cnt = nbytes;
-: 334:
-: 335: mask = 0x1;
-: 336: while (mask < comm_size)
-: 337: {
-: 338: if ((mask & relative_rank) == 0)
-: 339: {
-: 340: src = relative_rank | mask;
-: 341: if (src < comm_size)
-: 342: {
-: 343: src = (src + root) % comm_size;
-: 344: mpi_errno = MPIC_Recv(((char *)tmp_buf + curr_cnt),
-: 345: tmp_buf_size-curr_cnt, MPI_BYTE, src,
-: 346: MPIR_GATHER_TAG, comm,
-: 347: &status);
-: 348: /* --BEGIN ERROR HANDLING-- */
-: 349: if (mpi_errno)
-: 350: {
-: 351: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
-: 352: return mpi_errno;
-: 353: }
-: 354: /* --END ERROR HANDLING-- */
-: 355: /* the recv size is larger than what may be sent in
-: 356: some cases. query amount of data actually received */
-: 357: NMPI_Get_count(&status, MPI_BYTE, &recv_size);
-: 358: curr_cnt += recv_size;
-: 359: }
-: 360: }
-: 361: else
-: 362: {
-: 363: dst = relative_rank ^ mask;
-: 364: dst = (dst + root) % comm_size;
-: 365: mpi_errno = MPIC_Send(tmp_buf, curr_cnt, MPI_BYTE, dst,
-: 366: MPIR_GATHER_TAG, comm);
-: 367: /* --BEGIN ERROR HANDLING-- */
-: 368: if (mpi_errno)
-: 369: {
-: 370: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
-: 371: return mpi_errno;
-: 372: }
-: 373: /* --END ERROR HANDLING-- */
-: 374: break;
-: 375: }
-: 376: mask <<= 1;
-: 377: }
-: 378:
-: 379: if (rank == root)
-: 380: {
-: 381: /* reorder and copy from tmp_buf into recvbuf */
-: 382: if (sendbuf != MPI_IN_PLACE)
-: 383: {
-: 384: position = 0;
-: 385: NMPI_Unpack(tmp_buf, tmp_buf_size, &position,
-: 386: ((char *) recvbuf + extent*recvcnt*rank),
-: 387: recvcnt*(comm_size-rank), recvtype, comm);
-: 388: }
-: 389: else
-: 390: {
-: 391: position = nbytes;
-: 392: NMPI_Unpack(tmp_buf, tmp_buf_size, &position,
-: 393: ((char *) recvbuf + extent*recvcnt*(rank+1)),
-: 394: recvcnt*(comm_size-rank-1), recvtype,
-: 395: comm);
-: 396: }
-: 397: if (root != 0)
-: 398: NMPI_Unpack(tmp_buf, tmp_buf_size, &position, recvbuf,
-: 399: recvcnt*rank, recvtype, comm);
-: 400: }
-: 401:
-: 402: MPIU_Free(tmp_buf);
-: 403: }
-: 404:#endif /* MPID_HAS_HETERO */
-: 405:
17497: 406: fn_fail:
-: 407: /* check if multiple threads are calling this collective function */
-: 408: MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
-: 409:
|
17497: 410: return (mpi_errno);
-: 411:}
-: 412:/* end:nested */
-: 413:
-: 414:/* begin:nested */
-: 415:/* not declared static because a machine-specific function may call this one in some cases */
-: 416:int MPIR_Gather_inter (
-: 417: void *sendbuf,
-: 418: int sendcnt,
-: 419: MPI_Datatype sendtype,
-: 420: void *recvbuf,
-: 421: int recvcnt,
-: 422: MPI_Datatype recvtype,
-: 423: int root,
-: 424: MPID_Comm *comm_ptr )
1440: 425:{
-: 426:/* Intercommunicator gather.
-: 427: For short messages, remote group does a local intracommunicator
-: 428: gather to rank 0. Rank 0 then sends data to root.
-: 429:
-: 430: Cost: (lgp+1).alpha + n.((p-1)/p).beta + n.beta
-: 431:
-: 432: For long messages, we use linear gather to avoid the extra n.beta.
-: 433:
-: 434: Cost: p.alpha + n.beta
-: 435:*/
-: 436:
-: 437: static const char FCNAME[] = "MPIR_Gather_inter";
1440: 438: int rank, local_size, remote_size, mpi_errno=MPI_SUCCESS;
-: 439: int i, nbytes, sendtype_size, recvtype_size;
-: 440: MPI_Status status;
1440: 441: MPI_Aint extent, true_extent, true_lb = 0;
1440: 442: void *tmp_buf=NULL;
1440: 443: MPID_Comm *newcomm_ptr = NULL;
-: 444: MPI_Comm comm;
-: 445:
1440: 446: if (root == MPI_PROC_NULL)
-: 447: {
-: 448: /* local processes other than root do nothing */
240: 449: return MPI_SUCCESS;
-: 450: }
-: 451:
1200: 452: comm = comm_ptr->handle;
1200: 453: remote_size = comm_ptr->remote_size;
1200: 454: local_size = comm_ptr->local_size;
-: 455:
1200: 456: if (root == MPI_ROOT)
-: 457: {
256: 458: MPID_Datatype_get_size_macro(recvtype, recvtype_size);
256: 459: nbytes = recvtype_size * recvcnt * remote_size;
-: 460: }
-: 461: else
-: 462: {
-: 463: /* remote side */
944: 464: MPID_Datatype_get_size_macro(sendtype, sendtype_size);
944: 465: nbytes = sendtype_size * sendcnt * local_size;
-: 466: }
-: 467:
1200: 468: if (nbytes < MPIR_GATHER_SHORT_MSG)
-: 469: {
557: 470: if (root == MPI_ROOT)
-: 471: {
-: 472: /* root receives data from rank 0 on remote group */
-: 473: MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );
120: 474: mpi_errno = MPIC_Recv(recvbuf, recvcnt*remote_size,
-: 475: recvtype, 0, MPIR_GATHER_TAG, comm,
-: 476: &status);
-: 477: MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
-: 478:
120: 479: return mpi_errno;
-: 480: }
-: 481: else
-: 482: {
-: 483: /* remote group. Rank 0 allocates temporary buffer, does
-: 484: local intracommunicator gather, and then sends the data
-: 485: to root. */
-: 486:
437: 487: rank = comm_ptr->rank;
-: 488:
437: 489: if (rank == 0)
-: 490: {
120: 491: mpi_errno = NMPI_Type_get_true_extent(sendtype, &true_lb,
-: 492: &true_extent);
|
-: 493: /* --BEGIN ERROR HANDLING-- */
120: 494: if (mpi_errno)
-: 495: {
#####: 496: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 497: return mpi_errno;
-: 498: }
-: 499: /* --END ERROR HANDLING-- */
|
120: 500: MPID_Datatype_get_extent_macro(sendtype, extent);
-: 501:
-: 502: MPID_Ensure_Aint_fits_in_pointer(sendcnt*local_size*
-: 503: (MPIR_MAX(extent, true_extent)));
120: 504: tmp_buf =
-: 505: MPIU_Malloc(sendcnt*local_size*(MPIR_MAX(extent,true_extent)));
|
-: 506: /* --BEGIN ERROR HANDLING-- */
120: 507: if (!tmp_buf)
-: 508: {
#####: 509: mpi_errno = MPIR_Err_create_code( MPI_SUCCESS, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**nomem", 0 );
#####: 510: return mpi_errno;
-: 511: }
-: 512: /* --END ERROR HANDLING-- */
-: 513: /* adjust for potential negative lower bound in datatype */
|
120: 514: tmp_buf = (void *)((char*)tmp_buf - true_lb);
-: 515: }
-: 516:
-: 517: /* all processes in remote group form new intracommunicator */
437: 518: if (!comm_ptr->local_comm)
59: 519: MPIR_Setup_intercomm_localcomm( comm_ptr );
-: 520:
437: 521: newcomm_ptr = comm_ptr->local_comm;
-: 522:
-: 523: /* now do the a local gather on this intracommunicator */
437: 524: mpi_errno = MPIR_Gather(sendbuf, sendcnt, sendtype,
-: 525: tmp_buf, sendcnt, sendtype, 0,
-: 526: newcomm_ptr);
437: 527: if (rank == 0)
-: 528: {
-: 529: MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );
120: 530: mpi_errno = MPIC_Send(tmp_buf, sendcnt*local_size,
-: 531: sendtype, root,
-: 532: MPIR_GATHER_TAG, comm);
-: 533: MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
|
-: 534: /* --BEGIN ERROR HANDLING-- */
120: 535: if (mpi_errno)
-: 536: {
#####: 537: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 538: return mpi_errno;
-: 539: }
-: 540: /* --END ERROR HANDLING-- */
|
120: 541: MPIU_Free(((char*)tmp_buf+true_lb));
-: 542: }
-: 543: }
-: 544: }
-: 545: else
-: 546: {
-: 547: /* long message. use linear algorithm. */
-: 548: MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER( comm_ptr );
643: 549: if (root == MPI_ROOT)
-: 550: {
136: 551: MPID_Datatype_get_extent_macro(recvtype, extent);
-: 552: MPID_Ensure_Aint_fits_in_pointer(MPI_VOID_PTR_CAST_TO_MPI_AINT recvbuf +
-: 553: (recvcnt*remote_size*extent));
-: 554:
643: 555: for (i=0; i<remote_size; i++)
-: 556: {
507: 557: mpi_errno = MPIC_Recv(((char *)recvbuf+recvcnt*i*extent),
-: 558: recvcnt, recvtype, i,
-: 559: MPIR_GATHER_TAG, comm, &status);
|
-: 560: /* --BEGIN ERROR HANDLING-- */
507: 561: if (mpi_errno)
-: 562: {
#####: 563: mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**fail", 0);
#####: 564: return mpi_errno;
-: 565: }
-: 566: /* --END ERROR HANDLING-- */
-: 567: }
-: 568: }
-: 569: else
-: 570: {
|
507: 571: mpi_errno = MPIC_Send(sendbuf,sendcnt,sendtype,root,
-: 572: MPIR_GATHER_TAG,comm);
-: 573: }
-: 574: MPIDU_ERR_CHECK_MULTIPLE_THREADS_EXIT( comm_ptr );
-: 575: }
-: 576:
1080: 577: return mpi_errno;
-: 578:}
-: 579:/* end:nested */
-: 580:#endif
-: 581:
-: 582:#undef FUNCNAME
-: 583:#define FUNCNAME MPI_Gather
-: 584:
-: 585:/*@
-: 586:
-: 587:MPI_Gather - Gathers together values from a group of processes
-: 588:
-: 589:Input Parameters:
-: 590:+ sendbuf - starting address of send buffer (choice)
-: 591:. sendcount - number of elements in send buffer (integer)
-: 592:. sendtype - data type of send buffer elements (handle)
-: 593:. recvcount - number of elements for any single receive (integer,
-: 594:significant only at root)
-: 595:. recvtype - data type of recv buffer elements
-: 596:(significant only at root) (handle)
-: 597:. root - rank of receiving process (integer)
-: 598:- comm - communicator (handle)
-: 599:
-: 600:Output Parameter:
-: 601:. recvbuf - address of receive buffer (choice, significant only at 'root')
-: 602:
-: 603:.N ThreadSafe
-: 604:
-: 605:.N Fortran
-: 606:
-: 607:.N Errors
-: 608:.N MPI_SUCCESS
-: 609:.N MPI_ERR_COMM
-: 610:.N MPI_ERR_COUNT
-: 611:.N MPI_ERR_TYPE
-: 612:.N MPI_ERR_BUFFER
-: 613:@*/
-: 614:int MPI_Gather(void *sendbuf, int sendcnt, MPI_Datatype sendtype,
-: 615: void *recvbuf, int recvcnt, MPI_Datatype recvtype,
-: 616: int root, MPI_Comm comm)
16207: 617:{
-: 618: static const char FCNAME[] = "MPI_Gather";
16207: 619: int mpi_errno = MPI_SUCCESS;
16207: 620: MPID_Comm *comm_ptr = NULL;
16207: 621: MPIU_THREADPRIV_DECL;
-: 622: MPID_MPI_STATE_DECL(MPID_STATE_MPI_GATHER);
-: 623:
16207: 624: MPIR_ERRTEST_INITIALIZED_ORDIE();
-: 625:
16207: 626: MPIU_THREAD_CS_ENTER(ALLFUNC,);
-: 627: MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_GATHER);
-: 628:
-: 629: /* Validate parameters, especially handles needing to be converted */
|
-: 630:# ifdef HAVE_ERROR_CHECKING
-: 631: {
-: 632: MPID_BEGIN_ERROR_CHECKS;
-: 633: {
16207: 634: MPIR_ERRTEST_COMM(comm, mpi_errno);
16207: 635: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 636: }
-: 637: MPID_END_ERROR_CHECKS;
-: 638: }
-: 639:# endif /* HAVE_ERROR_CHECKING */
-: 640:
-: 641: /* Convert MPI object handles to object pointers */
|
16205: 642: MPID_Comm_get_ptr( comm, comm_ptr );
-: 643:
-: 644: /* Validate parameters and objects (post conversion) */
|
-: 645:# ifdef HAVE_ERROR_CHECKING
-: 646: {
-: 647: MPID_BEGIN_ERROR_CHECKS;
-: 648: {
16205: 649: MPID_Datatype *sendtype_ptr=NULL, *recvtype_ptr=NULL;
-: 650: int rank;
-: 651:
16205: 652: MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
16205: 653: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 654:
16203: 655: if (comm_ptr->comm_kind == MPID_INTRACOMM) {
14763: 656: MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno);
-: 657:
14763: 658: if (sendbuf != MPI_IN_PLACE) {
14443: 659: MPIR_ERRTEST_COUNT(sendcnt, mpi_errno);
14443: 660: MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
14443: 661: if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
2354: 662: MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
2354: 663: MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno );
2354: 664: MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno );
-: 665: }
14443: 666: MPIR_ERRTEST_USERBUFFER(sendbuf,sendcnt,sendtype,mpi_errno);
-: 667: }
-: 668:
14763: 669: rank = comm_ptr->rank;
14763: 670: if (rank == root) {
5376: 671: MPIR_ERRTEST_COUNT(recvcnt, mpi_errno);
5376: 672: MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
5376: 673: if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
361: 674: MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
361: 675: MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno );
361: 676: MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno );
-: 677: }
5376: 678: MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcnt, mpi_errno);
5376: 679: MPIR_ERRTEST_USERBUFFER(recvbuf,recvcnt,recvtype,mpi_errno);
-: 680: }
-: 681: else
9387: 682: MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcnt, mpi_errno);
-: 683: }
-: 684:
16203: 685: if (comm_ptr->comm_kind == MPID_INTERCOMM) {
1440: 686: MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno);
-: 687:
1440: 688: if (root == MPI_ROOT) {
256: 689: MPIR_ERRTEST_COUNT(recvcnt, mpi_errno);
256: 690: MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
256: 691: if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
#####: 692: MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
#####: 693: MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno );
#####: 694: MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno );
-: 695: }
256: 696: MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcnt, mpi_errno);
256: 697: MPIR_ERRTEST_USERBUFFER(recvbuf,recvcnt,recvtype,mpi_errno);
-: 698: }
-: 699:
1184: 700: else if (root != MPI_PROC_NULL) {
944: 701: MPIR_ERRTEST_COUNT(sendcnt, mpi_errno);
944: 702: MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
944: 703: if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
#####: 704: MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
#####: 705: MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno );
#####: 706: MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno );
-: 707: }
944: 708: MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcnt, mpi_errno);
944: 709: MPIR_ERRTEST_USERBUFFER(sendbuf,sendcnt,sendtype,mpi_errno);
-: 710: }
-: 711: }
-: 712:
16203: 713: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 714: }
-: 715: MPID_END_ERROR_CHECKS;
-: 716: }
-: 717:# endif /* HAVE_ERROR_CHECKING */
-: 718:
-: 719: /* ... body of routine ... */
-: 720:
|
16195: 721: if (comm_ptr->coll_fns != NULL && comm_ptr->coll_fns->Gather != NULL)
-: 722: {
|
#####: 723: mpi_errno = comm_ptr->coll_fns->Gather(sendbuf, sendcnt,
-: 724: sendtype, recvbuf, recvcnt,
-: 725: recvtype, root, comm_ptr);
-: 726: }
-: 727: else
-: 728: {
|
16195: 729: MPIU_THREADPRIV_GET;
-: 730:
16195: 731: MPIR_Nest_incr();
16195: 732: if (comm_ptr->comm_kind == MPID_INTRACOMM)
-: 733: /* intracommunicator */
14755: 734: mpi_errno = MPIR_Gather(sendbuf, sendcnt, sendtype,
-: 735: recvbuf, recvcnt, recvtype, root,
-: 736: comm_ptr);
-: 737: else
-: 738: {
-: 739: /* intercommunicator */
1440: 740: mpi_errno = MPIR_Gather_inter(sendbuf, sendcnt, sendtype,
-: 741: recvbuf, recvcnt, recvtype, root,
-: 742: comm_ptr);
-: 743: }
16195: 744: MPIR_Nest_decr();
-: 745: }
-: 746:
|
16195: 747: if (mpi_errno != MPI_SUCCESS) goto fn_fail;
-: 748:
-: 749: /* ... end of body of routine ... */
-: 750:
|
16207: 751: fn_exit:
|
-: 752: MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_GATHER);
|
16207: 753: MPIU_THREAD_CS_EXIT(ALLFUNC,);
16207: 754: return mpi_errno;
-: 755:
|
12: 756: fn_fail:
-: 757: /* --BEGIN ERROR HANDLING-- */
-: 758:# ifdef HAVE_ERROR_CHECKING
-: 759: {
12: 760: mpi_errno = MPIR_Err_create_code(
-: 761: mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_gather",
-: 762: "**mpi_gather %p %d %D %p %d %D %d %C", sendbuf, sendcnt, sendtype, recvbuf, recvcnt, recvtype, root, comm);
-: 763: }
-: 764:# endif
12: 765: mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
12: 766: goto fn_exit;
-: 767: /* --END ERROR HANDLING-- */
-: 768:}
|