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