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) 2015-2016 Research Organization for Information Science
14 * and Technology (RIST). All rights reserved.
15 * $COPYRIGHT$
16 *
17 * Additional copyrights may follow
18 *
19 * $HEADER$
20 */
21
22 #include "ompi_config.h"
23 #include "coll_inter.h"
24
25 #include "mpi.h"
26 #include "ompi/constants.h"
27 #include "ompi/datatype/ompi_datatype.h"
28 #include "ompi/mca/coll/coll.h"
29 #include "ompi/mca/coll/base/coll_tags.h"
30 #include "ompi/mca/pml/pml.h"
31
32
33 /*
34 * gather_inter
35 *
36 * Function: - basic gather operation
37 * Accepts: - same arguments as MPI_Gather()
38 * Returns: - MPI_SUCCESS or error code
39 */
40 int
41 mca_coll_inter_gather_inter(const void *sbuf, int scount,
42 struct ompi_datatype_t *sdtype,
43 void *rbuf, int rcount,
44 struct ompi_datatype_t *rdtype,
45 int root, struct ompi_communicator_t *comm,
46 mca_coll_base_module_t *module)
47 {
48 int err;
49 int rank;
50 int size;
51
52 size = ompi_comm_remote_size(comm);
53 rank = ompi_comm_rank(comm);
54
55 if (MPI_PROC_NULL == root) {
56 /* do nothing */
57 err = OMPI_SUCCESS;
58 } else if (MPI_ROOT != root) {
59 /* Perform the gather locally with the first process as root */
60 char *ptmp_free = NULL, *ptmp;
61 int size_local;
62 ptrdiff_t gap, span;
63
64 size_local = ompi_comm_size(comm->c_local_comm);
65 span = opal_datatype_span(&sdtype->super, (int64_t)scount*(int64_t)size_local, &gap);
66
67 ptmp_free = (char*)malloc(span);
68 if (NULL == ptmp_free) {
69 return OMPI_ERR_OUT_OF_RESOURCE;
70 }
71 ptmp = ptmp_free - gap;
72
73 err = comm->c_local_comm->c_coll->coll_gather(sbuf, scount, sdtype,
74 ptmp, scount, sdtype,
75 0, comm->c_local_comm,
76 comm->c_local_comm->c_coll->coll_gather_module);
77 if (0 == rank) {
78 /* First process sends data to the root */
79 err = MCA_PML_CALL(send(ptmp, scount*size_local, sdtype, root,
80 MCA_COLL_BASE_TAG_GATHER,
81 MCA_PML_BASE_SEND_STANDARD, comm));
82 if (OMPI_SUCCESS != err) {
83 return err;
84 }
85 }
86 free(ptmp_free);
87 } else {
88 /* I am the root, loop receiving the data. */
89 err = MCA_PML_CALL(recv(rbuf, rcount*size, rdtype, 0,
90 MCA_COLL_BASE_TAG_GATHER,
91 comm, MPI_STATUS_IGNORE));
92 if (OMPI_SUCCESS != err) {
93 return err;
94 }
95 }
96
97 /* All done */
98 return err;
99 }