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) 2015 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 "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 * gatherv_intra
34 *
35 * Function: - basic gatherv operation
36 * Accepts: - same arguments as MPI_Gatherv()
37 * Returns: - MPI_SUCCESS or error code
38 */
39 int
40 mca_coll_basic_gatherv_intra(const void *sbuf, int scount,
41 struct ompi_datatype_t *sdtype,
42 void *rbuf, const int *rcounts, const int *disps,
43 struct ompi_datatype_t *rdtype, int root,
44 struct ompi_communicator_t *comm,
45 mca_coll_base_module_t *module)
46 {
47 int i, rank, size, err;
48 char *ptmp;
49 ptrdiff_t lb, extent;
50
51 size = ompi_comm_size(comm);
52 rank = ompi_comm_rank(comm);
53
54 /* Everyone but root sends data and returns. Don't send anything
55 for sendcounts of 0 (even though MPI_Gatherv has a guard for 0
56 counts, this routine is used elsewhere, like the implementation
57 of allgatherv, so it's possible to get here with a scount of
58 0) */
59
60 if (rank != root) {
61 if (scount > 0) {
62 return MCA_PML_CALL(send(sbuf, scount, sdtype, root,
63 MCA_COLL_BASE_TAG_GATHERV,
64 MCA_PML_BASE_SEND_STANDARD, comm));
65 }
66 return MPI_SUCCESS;
67 }
68
69 /* I am the root, loop receiving data. */
70
71 err = ompi_datatype_get_extent(rdtype, &lb, &extent);
72 if (OMPI_SUCCESS != err) {
73 return OMPI_ERROR;
74 }
75
76 for (i = 0; i < size; ++i) {
77 ptmp = ((char *) rbuf) + (extent * disps[i]);
78
79 if (i == rank) {
80 /* simple optimization */
81 if (MPI_IN_PLACE != sbuf && (0 < scount) && (0 < rcounts[i])) {
82 err = ompi_datatype_sndrcv(sbuf, scount, sdtype,
83 ptmp, rcounts[i], rdtype);
84 }
85 } else {
86 /* Only receive if there is something to receive */
87 if (rcounts[i] > 0) {
88 err = MCA_PML_CALL(recv(ptmp, rcounts[i], rdtype, i,
89 MCA_COLL_BASE_TAG_GATHERV,
90 comm, MPI_STATUS_IGNORE));
91 }
92 }
93
94 if (MPI_SUCCESS != err) {
95 return err;
96 }
97 }
98
99 /* All done */
100
101 return MPI_SUCCESS;
102 }
103
104
105 /*
106 * gatherv_inter
107 *
108 * Function: - basic gatherv operation
109 * Accepts: - same arguments as MPI_Gatherv()
110 * Returns: - MPI_SUCCESS or error code
111 */
112 int
113 mca_coll_basic_gatherv_inter(const void *sbuf, int scount,
114 struct ompi_datatype_t *sdtype,
115 void *rbuf, const int *rcounts, const int *disps,
116 struct ompi_datatype_t *rdtype, int root,
117 struct ompi_communicator_t *comm,
118 mca_coll_base_module_t *module)
119 {
120 int i, size, err;
121 char *ptmp;
122 ptrdiff_t lb, extent;
123 ompi_request_t **reqs = NULL;
124
125 size = ompi_comm_remote_size(comm);
126
127 /* If not root, receive data. Note that we will only get here if
128 * scount > 0 or rank == root. */
129
130 if (MPI_PROC_NULL == root) {
131 /* do nothing */
132 err = OMPI_SUCCESS;
133 } else if (MPI_ROOT != root) {
134 /* Everyone but root sends data and returns. */
135 err = MCA_PML_CALL(send(sbuf, scount, sdtype, root,
136 MCA_COLL_BASE_TAG_GATHERV,
137 MCA_PML_BASE_SEND_STANDARD, comm));
138 } else {
139 /* I am the root, loop receiving data. */
140 err = ompi_datatype_get_extent(rdtype, &lb, &extent);
141 if (OMPI_SUCCESS != err) {
142 return OMPI_ERROR;
143 }
144
145 reqs = ompi_coll_base_comm_get_reqs(module->base_data, size);
146 if( NULL == reqs ) { return OMPI_ERR_OUT_OF_RESOURCE; }
147
148 for (i = 0; i < size; ++i) {
149 ptmp = ((char *) rbuf) + (extent * disps[i]);
150 err = MCA_PML_CALL(irecv(ptmp, rcounts[i], rdtype, i,
151 MCA_COLL_BASE_TAG_GATHERV,
152 comm, &reqs[i]));
153 if (OMPI_SUCCESS != err) {
154 ompi_coll_base_free_reqs(reqs, i + 1);
155 return err;
156 }
157 }
158
159 err = ompi_request_wait_all(size, reqs, MPI_STATUSES_IGNORE);
160 if (OMPI_SUCCESS != err) {
161 ompi_coll_base_free_reqs(reqs, size);
162 }
163 }
164
165 /* All done */
166 return err;
167 }