src/smpi/colls/reduce/reduce-ompi.cpp

   1 /* Copyright (c) 2013-2019. The SimGrid Team.
   2  * All rights reserved.                                                     */
   3
   4 /* This program is free software; you can redistribute it and/or modify it
   5  * under the terms of the license (GNU LGPL) which comes with this package. */
   6
   7 /*
   8  * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
   9  *                         University Research and Technology
  10  *                         Corporation.  All rights reserved.
  11  * Copyright (c) 2004-2009 The University of Tennessee and The University
  12  *                         of Tennessee Research Foundation.  All rights
  13  *                         reserved.
  14  * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
  15  *                         University of Stuttgart.  All rights reserved.
  16  * Copyright (c) 2004-2005 The Regents of the University of California.
  17  *                         All rights reserved.
  18  *
  19  * Additional copyrights may follow
  20  */
  21
  22 #include "../coll_tuned_topo.hpp"
  23 #include "../colls_private.hpp"
  24
  25 namespace simgrid{
  26 namespace smpi{
  27
  28 int smpi_coll_tuned_ompi_reduce_generic(const void* sendbuf, void* recvbuf, int original_count,
  29                                     MPI_Datatype datatype, MPI_Op  op,
  30                                     int root, MPI_Comm comm,
  31                                     ompi_coll_tree_t* tree, int count_by_segment,
  32                                     int max_outstanding_reqs );
  33 /**
  34  * This is a generic implementation of the reduce protocol. It used the tree
  35  * provided as an argument and execute all operations using a segment of
  36  * count times a datatype.
  37  * For the last communication it will update the count in order to limit
  38  * the number of datatype to the original count (original_count)
  39  *
  40  * Note that for non-commutative operations we cannot save memory copy
  41  * for the first block: thus we must copy sendbuf to accumbuf on intermediate
  42  * to keep the optimized loop happy.
  43  */
  44 int smpi_coll_tuned_ompi_reduce_generic(const void* sendbuf, void* recvbuf, int original_count,
  45                                     MPI_Datatype datatype, MPI_Op  op,
  46                                     int root, MPI_Comm comm,
  47                                     ompi_coll_tree_t* tree, int count_by_segment,
  48                                     int max_outstanding_reqs )
  49 {
  50   unsigned char *inbuf[2] = {nullptr, nullptr}, *inbuf_free[2] = {nullptr, nullptr};
  51   unsigned char *accumbuf = nullptr, *accumbuf_free = nullptr;
  52   const unsigned char *local_op_buffer = nullptr, *sendtmpbuf = nullptr;
  53   ptrdiff_t extent, lower_bound, segment_increment;
  54   MPI_Request reqs[2] = {MPI_REQUEST_NULL, MPI_REQUEST_NULL};
  55   int num_segments, line, ret, segindex, i, rank;
  56   int recvcount, prevcount, inbi;
  57
  58   /**
  59    * Determine number of segments and number of elements
  60    * sent per operation
  61    */
  62   datatype->extent(&lower_bound, &extent);
  63   num_segments      = (original_count + count_by_segment - 1) / count_by_segment;
  64   segment_increment = count_by_segment * extent;
  65
  66   sendtmpbuf = static_cast<const unsigned char*>(sendbuf);
  67   if (sendbuf == MPI_IN_PLACE) {
  68     sendtmpbuf = static_cast<const unsigned char*>(recvbuf);
  69     }
  70
  71     XBT_DEBUG("coll:tuned:reduce_generic count %d, msg size %lu, segsize %lu, max_requests %d", original_count,
  72               (unsigned long)(num_segments * segment_increment), (unsigned long)segment_increment,
  73               max_outstanding_reqs);
  74
  75     rank = comm->rank();
  76
  77     /* non-leaf nodes - wait for children to send me data & forward up
  78        (if needed) */
  79     if( tree->tree_nextsize > 0 ) {
  80         ptrdiff_t true_extent, real_segment_size;
  81         true_extent=datatype->get_extent();
  82
  83         /* handle non existant recv buffer (i.e. its NULL) and
  84            protect the recv buffer on non-root nodes */
  85         accumbuf = static_cast<unsigned char*>(recvbuf);
  86         if (nullptr == accumbuf || root != rank) {
  87           /* Allocate temporary accumulator buffer. */
  88           accumbuf_free = smpi_get_tmp_sendbuffer(true_extent + (original_count - 1) * extent);
  89           if (accumbuf_free == nullptr) {
  90             line = __LINE__;
  91             ret  = -1;
  92             goto error_hndl;
  93           }
  94           accumbuf = accumbuf_free - lower_bound;
  95         }
  96
  97         /* If this is a non-commutative operation we must copy
  98            sendbuf to the accumbuf, in order to simplfy the loops */
  99         if ((op != MPI_OP_NULL && not op->is_commutative())) {
 100           Datatype::copy(sendtmpbuf, original_count, datatype, accumbuf, original_count, datatype);
 101         }
 102         /* Allocate two buffers for incoming segments */
 103         real_segment_size = true_extent + (count_by_segment - 1) * extent;
 104         inbuf_free[0]     = smpi_get_tmp_recvbuffer(real_segment_size);
 105         if (inbuf_free[0] == nullptr) {
 106           line = __LINE__;
 107           ret  = -1;
 108           goto error_hndl;
 109         }
 110         inbuf[0] = inbuf_free[0] - lower_bound;
 111         /* if there is chance to overlap communication -
 112            allocate second buffer */
 113         if( (num_segments > 1) || (tree->tree_nextsize > 1) ) {
 114           inbuf_free[1] = smpi_get_tmp_recvbuffer(real_segment_size);
 115           if (inbuf_free[1] == nullptr) {
 116             line = __LINE__;
 117             ret  = -1;
 118             goto error_hndl;
 119             }
 120             inbuf[1] = inbuf_free[1] - lower_bound;
 121         }
 122
 123         /* reset input buffer index and receive count */
 124         inbi = 0;
 125         recvcount = 0;
 126         /* for each segment */
 127         for( segindex = 0; segindex <= num_segments; segindex++ ) {
 128             prevcount = recvcount;
 129             /* recvcount - number of elements in current segment */
 130             recvcount = count_by_segment;
 131             if( segindex == (num_segments-1) )
 132                 recvcount = original_count - count_by_segment * segindex;
 133
 134             /* for each child */
 135             for( i = 0; i < tree->tree_nextsize; i++ ) {
 136                 /**
 137                  * We try to overlap communication:
 138                  * either with next segment or with the next child
 139                  */
 140                 /* post irecv for current segindex on current child */
 141                 if( segindex < num_segments ) {
 142                     void* local_recvbuf = inbuf[inbi];
 143                     if( 0 == i ) {
 144                         /* for the first step (1st child per segment) and
 145                          * commutative operations we might be able to irecv
 146                          * directly into the accumulate buffer so that we can
 147                          * reduce(op) this with our sendbuf in one step as
 148                          * ompi_op_reduce only has two buffer pointers,
 149                          * this avoids an extra memory copy.
 150                          *
 151                          * BUT if the operation is non-commutative or
 152                          * we are root and are USING MPI_IN_PLACE this is wrong!
 153                          */
 154                         if(  (op==MPI_OP_NULL || op->is_commutative()) &&
 155                             !((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
 156                             local_recvbuf = accumbuf + segindex * segment_increment;
 157                         }
 158                     }
 159
 160                     reqs[inbi]=Request::irecv(local_recvbuf, recvcount, datatype,
 161                                              tree->tree_next[i],
 162                                              COLL_TAG_REDUCE, comm
 163                                              );
 164                 }
 165                 /* wait for previous req to complete, if any.
 166                    if there are no requests reqs[inbi ^1] will be
 167                    MPI_REQUEST_NULL. */
 168                 /* wait on data from last child for previous segment */
 169                 Request::waitall( 1, &reqs[inbi ^ 1],
 170                                              MPI_STATUSES_IGNORE );
 171                 local_op_buffer = inbuf[inbi ^ 1];
 172                 if( i > 0 ) {
 173                     /* our first operation is to combine our own [sendbuf] data
 174                      * with the data we recvd from down stream (but only
 175                      * the operation is commutative and if we are not root and
 176                      * not using MPI_IN_PLACE)
 177                      */
 178                     if( 1 == i ) {
 179                         if( (op==MPI_OP_NULL || op->is_commutative())&&
 180                             !((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
 181                             local_op_buffer = sendtmpbuf + segindex * segment_increment;
 182                         }
 183                     }
 184                     /* apply operation */
 185                     if(op!=MPI_OP_NULL) op->apply( local_op_buffer,
 186                                    accumbuf + segindex * segment_increment,
 187                                    &recvcount, datatype );
 188                 } else if ( segindex > 0 ) {
 189                     void* accumulator = accumbuf + (segindex-1) * segment_increment;
 190                     if( tree->tree_nextsize <= 1 ) {
 191                         if(  (op==MPI_OP_NULL || op->is_commutative()) &&
 192                             !((MPI_IN_PLACE == sendbuf) && (rank == tree->tree_root)) ) {
 193                             local_op_buffer = sendtmpbuf + (segindex-1) * segment_increment;
 194                         }
 195                     }
 196                     if(op!=MPI_OP_NULL) op->apply( local_op_buffer, accumulator, &prevcount,
 197                                    datatype );
 198
 199                     /* all reduced on available data this step (i) complete,
 200                      * pass to the next process unless you are the root.
 201                      */
 202                     if (rank != tree->tree_root) {
 203                         /* send combined/accumulated data to parent */
 204                         Request::send( accumulator, prevcount,
 205                                                   datatype, tree->tree_prev,
 206                                                   COLL_TAG_REDUCE,
 207                                                   comm);
 208                     }
 209
 210                     /* we stop when segindex = number of segments
 211                        (i.e. we do num_segment+1 steps for pipelining */
 212                     if (segindex == num_segments) break;
 213                 }
 214
 215                 /* update input buffer index */
 216                 inbi = inbi ^ 1;
 217             } /* end of for each child */
 218         } /* end of for each segment */
 219
 220         /* clean up */
 221         smpi_free_tmp_buffer(inbuf_free[0]);
 222         smpi_free_tmp_buffer(inbuf_free[1]);
 223         smpi_free_tmp_buffer(accumbuf_free);
 224     }
 225
 226     /* leaf nodes
 227        Depending on the value of max_outstanding_reqs and
 228        the number of segments we have two options:
 229        - send all segments using blocking send to the parent, or
 230        - avoid overflooding the parent nodes by limiting the number of
 231        outstanding requests to max_oustanding_reqs.
 232        TODO/POSSIBLE IMPROVEMENT: If there is a way to determine the eager size
 233        for the current communication, synchronization should be used only
 234        when the message/segment size is smaller than the eager size.
 235     */
 236     else {
 237
 238         /* If the number of segments is less than a maximum number of oustanding
 239            requests or there is no limit on the maximum number of outstanding
 240            requests, we send data to the parent using blocking send */
 241         if ((0 == max_outstanding_reqs) ||
 242             (num_segments <= max_outstanding_reqs)) {
 243
 244             segindex = 0;
 245             while ( original_count > 0) {
 246                 if (original_count < count_by_segment) {
 247                     count_by_segment = original_count;
 248                 }
 249                 Request::send((char*)sendbuf +
 250                                          segindex * segment_increment,
 251                                          count_by_segment, datatype,
 252                                          tree->tree_prev,
 253                                          COLL_TAG_REDUCE,
 254                                          comm) ;
 255                 segindex++;
 256                 original_count -= count_by_segment;
 257             }
 258         }
 259
 260         /* Otherwise, introduce flow control:
 261            - post max_outstanding_reqs non-blocking synchronous send,
 262            - for remaining segments
 263            - wait for a ssend to complete, and post the next one.
 264            - wait for all outstanding sends to complete.
 265         */
 266         else {
 267
 268             int creq = 0;
 269             MPI_Request* sreq = new (std::nothrow) MPI_Request[max_outstanding_reqs];
 270             if (NULL == sreq) { line = __LINE__; ret = -1; goto error_hndl; }
 271
 272             /* post first group of requests */
 273             for (segindex = 0; segindex < max_outstanding_reqs; segindex++) {
 274                 sreq[segindex]=Request::isend((char*)sendbuf +
 275                                           segindex * segment_increment,
 276                                           count_by_segment, datatype,
 277                                           tree->tree_prev,
 278                                           COLL_TAG_REDUCE,
 279                                           comm);
 280                 original_count -= count_by_segment;
 281             }
 282
 283             creq = 0;
 284             while ( original_count > 0 ) {
 285                 /* wait on a posted request to complete */
 286                 Request::wait(&sreq[creq], MPI_STATUS_IGNORE);
 287                 sreq[creq] = MPI_REQUEST_NULL;
 288
 289                 if( original_count < count_by_segment ) {
 290                     count_by_segment = original_count;
 291                 }
 292                 sreq[creq]=Request::isend((char*)sendbuf +
 293                                           segindex * segment_increment,
 294                                           count_by_segment, datatype,
 295                                           tree->tree_prev,
 296                                           COLL_TAG_REDUCE,
 297                                           comm );
 298                 creq = (creq + 1) % max_outstanding_reqs;
 299                 segindex++;
 300                 original_count -= count_by_segment;
 301             }
 302
 303             /* Wait on the remaining request to complete */
 304             Request::waitall( max_outstanding_reqs, sreq,
 305                                          MPI_STATUSES_IGNORE );
 306
 307             /* free requests */
 308             delete[] sreq;
 309         }
 310     }
 311     ompi_coll_tuned_topo_destroy_tree(&tree);
 312     return MPI_SUCCESS;
 313
 314  error_hndl:  /* error handler */
 315     XBT_DEBUG("ERROR_HNDL: node %d file %s line %d error %d\n",
 316                    rank, __FILE__, line, ret );
 317     smpi_free_tmp_buffer(inbuf_free[0]);
 318     smpi_free_tmp_buffer(inbuf_free[1]);
 319     smpi_free_tmp_buffer(accumbuf);
 320     return ret;
 321 }
 322
 323 /* Attention: this version of the reduce operations does not
 324    work for:
 325    - non-commutative operations
 326    - segment sizes which are not multiplies of the extent of the datatype
 327      meaning that at least one datatype must fit in the segment !
 328 */
 329
 330
 331 int Coll_reduce_ompi_chain::reduce(const void *sendbuf, void *recvbuf, int count,
 332                                         MPI_Datatype datatype,
 333                                         MPI_Op  op, int root,
 334                                         MPI_Comm  comm
 335                                         )
 336 {
 337     uint32_t segsize=64*1024;
 338     int segcount = count;
 339     size_t typelng;
 340     int fanout = comm->size()/2;
 341
 342     XBT_DEBUG("coll:tuned:reduce_intra_chain rank %d fo %d ss %5u", comm->rank(), fanout, segsize);
 343
 344     /**
 345      * Determine number of segments and number of elements
 346      * sent per operation
 347      */
 348     typelng = datatype->size();
 349
 350     COLL_TUNED_COMPUTED_SEGCOUNT( segsize, typelng, segcount );
 351
 352     return smpi_coll_tuned_ompi_reduce_generic( sendbuf, recvbuf, count, datatype,
 353                                            op, root, comm,
 354                                            ompi_coll_tuned_topo_build_chain(fanout, comm, root),
 355                                            segcount, 0 );
 356 }
 357
 358
 359 int Coll_reduce_ompi_pipeline::reduce(const void *sendbuf, void *recvbuf,
 360                                            int count, MPI_Datatype datatype,
 361                                            MPI_Op  op, int root,
 362                                            MPI_Comm  comm  )
 363 {
 364
 365     uint32_t segsize;
 366     int segcount = count;
 367     size_t typelng;
 368 //    COLL_TUNED_UPDATE_PIPELINE( comm, tuned_module, root );
 369
 370     /**
 371      * Determine number of segments and number of elements
 372      * sent per operation
 373      */
 374     const double a2 =  0.0410 / 1024.0; /* [1/B] */
 375     const double b2 =  9.7128;
 376     const double a4 =  0.0033 / 1024.0; /* [1/B] */
 377     const double b4 =  1.6761;
 378     typelng= datatype->size();
 379     int communicator_size = comm->size();
 380     size_t message_size = typelng * count;
 381
 382     if (communicator_size > (a2 * message_size + b2)) {
 383         // Pipeline_1K
 384         segsize = 1024;
 385     }else if (communicator_size > (a4 * message_size + b4)) {
 386         // Pipeline_32K
 387         segsize = 32*1024;
 388     } else {
 389         // Pipeline_64K
 390         segsize = 64*1024;
 391     }
 392
 393     XBT_DEBUG("coll:tuned:reduce_intra_pipeline rank %d ss %5u", comm->rank(), segsize);
 394
 395     COLL_TUNED_COMPUTED_SEGCOUNT( segsize, typelng, segcount );
 396
 397     return smpi_coll_tuned_ompi_reduce_generic( sendbuf, recvbuf, count, datatype,
 398                                            op, root, comm,
 399                                            ompi_coll_tuned_topo_build_chain( 1, comm, root),
 400                                            segcount, 0);
 401 }
 402
 403 int Coll_reduce_ompi_binary::reduce(const void *sendbuf, void *recvbuf,
 404                                          int count, MPI_Datatype datatype,
 405                                          MPI_Op  op, int root,
 406                                          MPI_Comm  comm)
 407 {
 408     uint32_t segsize;
 409     int segcount = count;
 410     size_t typelng;
 411
 412
 413
 414     /**
 415      * Determine number of segments and number of elements
 416      * sent per operation
 417      */
 418     typelng=datatype->size();
 419
 420         // Binary_32K
 421     segsize = 32*1024;
 422
 423     XBT_DEBUG("coll:tuned:reduce_intra_binary rank %d ss %5u", comm->rank(), segsize);
 424
 425     COLL_TUNED_COMPUTED_SEGCOUNT( segsize, typelng, segcount );
 426
 427     return smpi_coll_tuned_ompi_reduce_generic( sendbuf, recvbuf, count, datatype,
 428                                            op, root, comm,
 429                                            ompi_coll_tuned_topo_build_tree(2, comm, root),
 430                                            segcount, 0);
 431 }
 432
 433 int Coll_reduce_ompi_binomial::reduce(const void *sendbuf, void *recvbuf,
 434                                            int count, MPI_Datatype datatype,
 435                                            MPI_Op  op, int root,
 436                                            MPI_Comm  comm)
 437 {
 438
 439     uint32_t segsize=0;
 440     int segcount = count;
 441     size_t typelng;
 442
 443     const double a1 =  0.6016 / 1024.0; /* [1/B] */
 444     const double b1 =  1.3496;
 445
 446 //    COLL_TUNED_UPDATE_IN_ORDER_BMTREE( comm, tuned_module, root );
 447
 448     /**
 449      * Determine number of segments and number of elements
 450      * sent per operation
 451      */
 452     typelng= datatype->size();
 453     int communicator_size = comm->size();
 454     size_t message_size = typelng * count;
 455     if (((communicator_size < 8) && (message_size < 20480)) ||
 456                (message_size < 2048) || (count <= 1)) {
 457         /* Binomial_0K */
 458         segsize = 0;
 459     } else if (communicator_size > (a1 * message_size + b1)) {
 460         // Binomial_1K
 461         segsize = 1024;
 462     }
 463
 464     XBT_DEBUG("coll:tuned:reduce_intra_binomial rank %d ss %5u", comm->rank(), segsize);
 465     COLL_TUNED_COMPUTED_SEGCOUNT( segsize, typelng, segcount );
 466
 467     return smpi_coll_tuned_ompi_reduce_generic( sendbuf, recvbuf, count, datatype,
 468                                            op, root, comm,
 469                                            ompi_coll_tuned_topo_build_in_order_bmtree(comm, root),
 470                                            segcount, 0);
 471 }
 472
 473 /*
 474  * reduce_intra_in_order_binary
 475  *
 476  * Function:      Logarithmic reduce operation for non-commutative operations.
 477  * Acecpts:       same as MPI_Reduce()
 478  * Returns:       MPI_SUCCESS or error code
 479  */
 480 int Coll_reduce_ompi_in_order_binary::reduce(const void *sendbuf, void *recvbuf,
 481                                                   int count,
 482                                                   MPI_Datatype datatype,
 483                                                   MPI_Op  op, int root,
 484                                                   MPI_Comm  comm)
 485 {
 486     uint32_t segsize=0;
 487     int ret;
 488     int rank, size, io_root;
 489     int segcount = count;
 490     size_t typelng;
 491
 492     rank = comm->rank();
 493     size = comm->size();
 494     XBT_DEBUG("coll:tuned:reduce_intra_in_order_binary rank %d ss %5u", rank, segsize);
 495
 496     /**
 497      * Determine number of segments and number of elements
 498      * sent per operation
 499      */
 500     typelng=datatype->size();
 501     COLL_TUNED_COMPUTED_SEGCOUNT( segsize, typelng, segcount );
 502
 503     /* An in-order binary tree must use root (size-1) to preserve the order of
 504        operations.  Thus, if root is not rank (size - 1), then we must handle
 505        1. MPI_IN_PLACE option on real root, and
 506        2. we must allocate temporary recvbuf on rank (size - 1).
 507        Note that generic function must be careful not to switch order of
 508        operations for non-commutative ops.
 509     */
 510     io_root = size - 1;
 511     const void* use_this_sendbuf = sendbuf;
 512     void* use_this_recvbuf       = recvbuf;
 513     unsigned char* tmp_sendbuf   = nullptr;
 514     unsigned char* tmp_recvbuf   = nullptr;
 515     if (io_root != root) {
 516         ptrdiff_t text, ext;
 517
 518         ext=datatype->get_extent();
 519         text=datatype->get_extent();
 520
 521         if ((root == rank) && (MPI_IN_PLACE == sendbuf)) {
 522           tmp_sendbuf = smpi_get_tmp_sendbuffer(text + (count - 1) * ext);
 523           if (NULL == tmp_sendbuf) {
 524             return MPI_ERR_INTERN;
 525           }
 526           Datatype::copy(recvbuf, count, datatype, tmp_sendbuf, count, datatype);
 527           use_this_sendbuf = tmp_sendbuf;
 528         } else if (io_root == rank) {
 529           tmp_recvbuf = smpi_get_tmp_recvbuffer(text + (count - 1) * ext);
 530           if (NULL == tmp_recvbuf) {
 531             return MPI_ERR_INTERN;
 532           }
 533           use_this_recvbuf = tmp_recvbuf;
 534         }
 535     }
 536
 537     /* Use generic reduce with in-order binary tree topology and io_root */
 538     ret = smpi_coll_tuned_ompi_reduce_generic( use_this_sendbuf, use_this_recvbuf, count, datatype,
 539                                           op, io_root, comm,
 540                                           ompi_coll_tuned_topo_build_in_order_bintree(comm),
 541                                           segcount, 0 );
 542     if (MPI_SUCCESS != ret) { return ret; }
 543
 544     /* Clean up */
 545     if (io_root != root) {
 546         if (root == rank) {
 547             /* Receive result from rank io_root to recvbuf */
 548             Request::recv(recvbuf, count, datatype, io_root,
 549                                     COLL_TAG_REDUCE, comm,
 550                                     MPI_STATUS_IGNORE);
 551             if (MPI_IN_PLACE == sendbuf) {
 552               smpi_free_tmp_buffer(tmp_sendbuf);
 553             }
 554
 555         } else if (io_root == rank) {
 556             /* Send result from use_this_recvbuf to root */
 557             Request::send(use_this_recvbuf, count, datatype, root,
 558                                     COLL_TAG_REDUCE,
 559                                     comm);
 560             smpi_free_tmp_buffer(tmp_recvbuf);
 561         }
 562     }
 563
 564     return MPI_SUCCESS;
 565 }
 566
 567 /*
 568  * Linear functions are copied from the BASIC coll module
 569  * they do not segment the message and are simple implementations
 570  * but for some small number of nodes and/or small data sizes they
 571  * are just as fast as tuned/tree based segmenting operations
 572  * and as such may be selected by the decision functions
 573  * These are copied into this module due to the way we select modules
 574  * in V1. i.e. in V2 we will handle this differently and so will not
 575  * have to duplicate code.
 576  * GEF Oct05 after asking Jeff.
 577  */
 578
 579 /* copied function (with appropriate renaming) starts here */
 580
 581 /*
 582  *  reduce_lin_intra
 583  *
 584  *  Function:   - reduction using O(N) algorithm
 585  *  Accepts:    - same as MPI_Reduce()
 586  *  Returns:    - MPI_SUCCESS or error code
 587  */
 588
 589 int
 590 Coll_reduce_ompi_basic_linear::reduce(const void *sbuf, void *rbuf, int count,
 591                                           MPI_Datatype dtype,
 592                                           MPI_Op op,
 593                                           int root,
 594                                           MPI_Comm comm)
 595 {
 596     int i, rank, size;
 597     ptrdiff_t true_extent, lb, extent;
 598     unsigned char* free_buffer  = nullptr;
 599     unsigned char* pml_buffer   = nullptr;
 600     unsigned char* inplace_temp = nullptr;
 601     const unsigned char* inbuf;
 602
 603     /* Initialize */
 604
 605     rank = comm->rank();
 606     size = comm->size();
 607
 608     XBT_DEBUG("coll:tuned:reduce_intra_basic_linear rank %d", rank);
 609
 610     /* If not root, send data to the root. */
 611
 612     if (rank != root) {
 613         Request::send(sbuf, count, dtype, root,
 614                                 COLL_TAG_REDUCE,
 615                                 comm);
 616         return MPI_SUCCESS;
 617     }
 618
 619     /* see discussion in ompi_coll_basic_reduce_lin_intra about
 620        extent and true extent */
 621     /* for reducing buffer allocation lengths.... */
 622
 623     dtype->extent(&lb, &extent);
 624     true_extent = dtype->get_extent();
 625
 626     if (MPI_IN_PLACE == sbuf) {
 627         sbuf = rbuf;
 628         inplace_temp = smpi_get_tmp_recvbuffer(true_extent + (count - 1) * extent);
 629         if (nullptr == inplace_temp) {
 630           return -1;
 631         }
 632         rbuf = inplace_temp - lb;
 633     }
 634
 635     if (size > 1) {
 636       free_buffer = smpi_get_tmp_recvbuffer(true_extent + (count - 1) * extent);
 637       pml_buffer  = free_buffer - lb;
 638     }
 639
 640     /* Initialize the receive buffer. */
 641
 642     if (rank == (size - 1)) {
 643         Datatype::copy((char*)sbuf, count, dtype,(char*)rbuf, count, dtype);
 644     } else {
 645         Request::recv(rbuf, count, dtype, size - 1,
 646                                 COLL_TAG_REDUCE, comm,
 647                                 MPI_STATUS_IGNORE);
 648     }
 649
 650     /* Loop receiving and calling reduction function (C or Fortran). */
 651
 652     for (i = size - 2; i >= 0; --i) {
 653         if (rank == i) {
 654           inbuf = static_cast<const unsigned char*>(sbuf);
 655         } else {
 656             Request::recv(pml_buffer, count, dtype, i,
 657                                     COLL_TAG_REDUCE, comm,
 658                                     MPI_STATUS_IGNORE);
 659             inbuf = pml_buffer;
 660         }
 661
 662         /* Perform the reduction */
 663         if(op!=MPI_OP_NULL) op->apply( inbuf, rbuf, &count, dtype);
 664     }
 665
 666     if (nullptr != inplace_temp) {
 667       Datatype::copy(inplace_temp, count, dtype, (char*)sbuf, count, dtype);
 668       smpi_free_tmp_buffer(inplace_temp);
 669     }
 670     if (nullptr != free_buffer) {
 671       smpi_free_tmp_buffer(free_buffer);
 672     }
 673
 674     /* All done */
 675     return MPI_SUCCESS;
 676 }
 677
 678 /* copied function (with appropriate renaming) ends here */
 679
 680
 681 }
 682 }