root/ompi/mca/coll/basic/coll_basic_allgather.c

DEFINITIONS

1. mca_coll_basic_allgather_inter

   1 /*
   2  * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
   3  *                         University Research and Technology
   4  *                         Corporation.  All rights reserved.
   5  * Copyright (c) 2004-2016 The University of Tennessee and The University
   6  *                         of Tennessee Research Foundation.  All rights
   7  *                         reserved.
   8  * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
   9  *                         University of Stuttgart.  All rights reserved.
  10  * Copyright (c) 2004-2005 The Regents of the University of California.
  11  *                         All rights reserved.
  12  * Copyright (c) 2014-2016 Research Organization for Information Science
  13  *                         and Technology (RIST). All rights reserved.
  14  * Copyright (c) 2017      IBM Corporation. All rights reserved.
  15  * $COPYRIGHT$
  16  *
  17  * Additional copyrights may follow
  18  *
  19  * $HEADER$
  20  */
  21 
  22 #include "ompi_config.h"
  23 #include "coll_basic.h"
  24 
  25 #include <stdlib.h>
  26 
  27 #include "mpi.h"
  28 #include "ompi/constants.h"
  29 #include "ompi/datatype/ompi_datatype.h"
  30 #include "ompi/mca/coll/coll.h"
  31 #include "ompi/mca/pml/pml.h"
  32 #include "ompi/mca/coll/base/coll_tags.h"
  33 #include "coll_basic.h"
  34 
  35 
  36 /*
  37  *      allgather_inter
  38  *
  39  *      Function:       - allgather using other MPI collections
  40  *      Accepts:        - same as MPI_Allgather()
  41  *      Returns:        - MPI_SUCCESS or error code
  42  */
  43 int
  44 mca_coll_basic_allgather_inter(const void *sbuf, int scount,
  45                                struct ompi_datatype_t *sdtype,
  46                                void *rbuf, int rcount,
  47                                struct ompi_datatype_t *rdtype,
  48                                struct ompi_communicator_t *comm,
  49                                mca_coll_base_module_t *module)
  50 {
  51     int rank, root = 0, size, rsize, err, i, line;
  52     char *tmpbuf_free = NULL, *tmpbuf, *ptmp;
  53     ptrdiff_t rlb, rextent, incr;
  54     ptrdiff_t gap, span;
  55     ompi_request_t *req;
  56     ompi_request_t **reqs = NULL;
  57 
  58     rank = ompi_comm_rank(comm);
  59     size = ompi_comm_size(comm);
  60     rsize = ompi_comm_remote_size(comm);
  61 
  62     /* Algorithm:
  63      * - a gather to the root in remote group (simultaniously executed,
  64      * thats why we cannot use coll_gather).
  65      * - exchange the temp-results between two roots
  66      * - inter-bcast (again simultanious).
  67      */
  68 
  69     /* Step one: gather operations: */
  70     if (rank != root) {
  71         /* send your data to root */
  72         err = MCA_PML_CALL(send(sbuf, scount, sdtype, root,
  73                                 MCA_COLL_BASE_TAG_ALLGATHER,
  74                                 MCA_PML_BASE_SEND_STANDARD, comm));
  75         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
  76     } else {
  77         /* receive a msg. from all other procs. */
  78         err = ompi_datatype_get_extent(rdtype, &rlb, &rextent);
  79         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
  80 
  81         /* Get a requests arrays of the right size */
  82         reqs = ompi_coll_base_comm_get_reqs(module->base_data, rsize + 1);
  83         if( NULL == reqs ) { line = __LINE__; err = OMPI_ERR_OUT_OF_RESOURCE; goto exit; }
  84 
  85         /* Do a send-recv between the two root procs. to avoid deadlock */
  86         err = MCA_PML_CALL(isend(sbuf, scount, sdtype, 0,
  87                                  MCA_COLL_BASE_TAG_ALLGATHER,
  88                                  MCA_PML_BASE_SEND_STANDARD,
  89                                  comm, &reqs[rsize]));
  90         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
  91 
  92         err = MCA_PML_CALL(irecv(rbuf, rcount, rdtype, 0,
  93                                  MCA_COLL_BASE_TAG_ALLGATHER, comm,
  94                                  &reqs[0]));
  95         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
  96 
  97         incr = rextent * rcount;
  98         ptmp = (char *) rbuf + incr;
  99         for (i = 1; i < rsize; ++i, ptmp += incr) {
 100             err = MCA_PML_CALL(irecv(ptmp, rcount, rdtype, i,
 101                                      MCA_COLL_BASE_TAG_ALLGATHER,
 102                                      comm, &reqs[i]));
 103             if (MPI_SUCCESS != err) { line = __LINE__; goto exit; }
 104         }
 105 
 106         err = ompi_request_wait_all(rsize + 1, reqs, MPI_STATUSES_IGNORE);
 107         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
 108 
 109         /* Step 2: exchange the resuts between the root processes */
 110         span = opal_datatype_span(&sdtype->super, (int64_t)scount * (int64_t)size, &gap);
 111         tmpbuf_free = (char *) malloc(span);
 112         if (NULL == tmpbuf_free) { line = __LINE__; err = OMPI_ERR_OUT_OF_RESOURCE; goto exit; }
 113         tmpbuf = tmpbuf_free - gap;
 114 
 115         err = MCA_PML_CALL(isend(rbuf, rsize * rcount, rdtype, 0,
 116                                  MCA_COLL_BASE_TAG_ALLGATHER,
 117                                  MCA_PML_BASE_SEND_STANDARD, comm, &req));
 118         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
 119 
 120         err = MCA_PML_CALL(recv(tmpbuf, size * scount, sdtype, 0,
 121                                 MCA_COLL_BASE_TAG_ALLGATHER, comm,
 122                                 MPI_STATUS_IGNORE));
 123         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
 124 
 125         err = ompi_request_wait( &req, MPI_STATUS_IGNORE);
 126         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
 127     }
 128 
 129 
 130     /* Step 3: bcast the data to the remote group. This
 131      * happens in both groups simultaneously, thus we can
 132      * not use coll_bcast (this would deadlock).
 133      */
 134     if (rank != root) {
 135         /* post the recv */
 136         err = MCA_PML_CALL(recv(rbuf, rsize * rcount, rdtype, 0,
 137                                 MCA_COLL_BASE_TAG_ALLGATHER, comm,
 138                                 MPI_STATUS_IGNORE));
 139         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
 140 
 141     } else {
 142         /* Send the data to every other process in the remote group
 143          * except to rank zero. which has it already. */
 144         for (i = 1; i < rsize; i++) {
 145             err = MCA_PML_CALL(isend(tmpbuf, size * scount, sdtype, i,
 146                                      MCA_COLL_BASE_TAG_ALLGATHER,
 147                                      MCA_PML_BASE_SEND_STANDARD,
 148                                      comm, &reqs[i - 1]));
 149             if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
 150         }
 151 
 152         err = ompi_request_wait_all(rsize - 1, reqs, MPI_STATUSES_IGNORE);
 153         if (OMPI_SUCCESS != err) { line = __LINE__; goto exit; }
 154     }
 155 
 156   exit:
 157     if( MPI_SUCCESS != err ) {
 158         OPAL_OUTPUT( (ompi_coll_base_framework.framework_output,"%s:%4d\tError occurred %d, rank %2d",
 159                       __FILE__, line, err, rank) );
 160         (void)line;  // silence compiler warning
 161         if( NULL != reqs ) ompi_coll_base_free_reqs(reqs, rsize+1);
 162     }
 163     if (NULL != tmpbuf_free) {
 164         free(tmpbuf_free);
 165     }
 166 
 167     return err;
 168 }