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-2017 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) 2006-2007 University of Houston. All rights reserved.
13 * Copyright (c) 2013 Cisco Systems, Inc. All rights reserved.
14 * Copyright (c) 2015-2016 Research Organization for Information Science
15 * and Technology (RIST). All rights reserved.
16 * $COPYRIGHT$
17 *
18 * Additional copyrights may follow
19 *
20 * $HEADER$
21 */
22
23 #include "ompi_config.h"
24 #include "coll_inter.h"
25
26 #include <stdio.h>
27
28 #include "mpi.h"
29 #include "ompi/constants.h"
30 #include "ompi/mca/coll/coll.h"
31 #include "ompi/mca/coll/base/coll_tags.h"
32 #include "ompi/op/op.h"
33 #include "ompi/mca/pml/pml.h"
34
35 /*
36 * reduce_inter
37 *
38 * Function: - reduction using the local_comm
39 * Accepts: - same as MPI_Reduce()
40 * Returns: - MPI_SUCCESS or error code
41 */
42 int
43 mca_coll_inter_reduce_inter(const void *sbuf, void *rbuf, int count,
44 struct ompi_datatype_t *dtype,
45 struct ompi_op_t *op,
46 int root, struct ompi_communicator_t *comm,
47 mca_coll_base_module_t *module)
48 {
49 int rank, err;
50
51 /* Initialize */
52 rank = ompi_comm_rank(comm);
53
54 if (MPI_PROC_NULL == root) {
55 /* do nothing */
56 err = OMPI_SUCCESS;
57 } else if (MPI_ROOT != root) {
58 ptrdiff_t gap, span;
59 char *free_buffer = NULL;
60 char *pml_buffer = NULL;
61
62 /* Perform the reduce locally with the first process as root */
63 span = opal_datatype_span(&dtype->super, count, &gap);
64
65 free_buffer = (char*)malloc(span);
66 if (NULL == free_buffer) {
67 return OMPI_ERR_OUT_OF_RESOURCE;
68 }
69 pml_buffer = free_buffer - gap;
70
71 err = comm->c_local_comm->c_coll->coll_reduce(sbuf, pml_buffer, count,
72 dtype, op, 0, comm->c_local_comm,
73 comm->c_local_comm->c_coll->coll_reduce_module);
74 if (0 == rank) {
75 /* First process sends the result to the root */
76 err = MCA_PML_CALL(send(pml_buffer, count, dtype, root,
77 MCA_COLL_BASE_TAG_REDUCE,
78 MCA_PML_BASE_SEND_STANDARD, comm));
79 if (OMPI_SUCCESS != err) {
80 return err;
81 }
82 }
83
84 if (NULL != free_buffer) {
85 free(free_buffer);
86 }
87 } else {
88 /* Root receives the reduced message from the first process */
89 err = MCA_PML_CALL(recv(rbuf, count, dtype, 0,
90 MCA_COLL_BASE_TAG_REDUCE, comm,
91 MPI_STATUS_IGNORE));
92 if (OMPI_SUCCESS != err) {
93 return err;
94 }
95 }
96 /* All done */
97 return err;
98 }