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-2008 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 * scatter_inter
34 *
35 * Function: - scatter operation
36 * Accepts: - same arguments as MPI_Scatter()
37 * Returns: - MPI_SUCCESS or error code
38 */
39 int
40 mca_coll_inter_scatter_inter(const void *sbuf, int scount,
41 struct ompi_datatype_t *sdtype,
42 void *rbuf, int rcount,
43 struct ompi_datatype_t *rdtype,
44 int root, struct ompi_communicator_t *comm,
45 mca_coll_base_module_t *module)
46 {
47 int rank, size, err;
48
49 /* Initialize */
50
51 rank = ompi_comm_rank(comm);
52 size = ompi_comm_remote_size(comm);
53
54 if (MPI_PROC_NULL == root) {
55 /* do nothing */
56 err = OMPI_SUCCESS;
57 } else if (MPI_ROOT != root) {
58 /* First process receives the data from root */
59 char *ptmp_free = NULL, *ptmp = NULL;
60 if(0 == rank) {
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(&rdtype->super, (int64_t)rcount*(int64_t)size_local, &gap);
66 ptmp_free = malloc(span);
67 if (NULL == ptmp_free) {
68 return OMPI_ERR_OUT_OF_RESOURCE;
69 }
70 ptmp = ptmp_free - gap;
71
72 err = MCA_PML_CALL(recv(ptmp, rcount*size_local, rdtype,
73 root, MCA_COLL_BASE_TAG_SCATTER,
74 comm, MPI_STATUS_IGNORE));
75 if (OMPI_SUCCESS != err) {
76 return err;
77 }
78 }
79 /* Perform the scatter locally with the first process as root */
80 err = comm->c_local_comm->c_coll->coll_scatter(ptmp, rcount, rdtype,
81 rbuf, rcount, rdtype,
82 0, comm->c_local_comm,
83 comm->c_local_comm->c_coll->coll_scatter_module);
84 if (NULL != ptmp_free) {
85 free(ptmp_free);
86 }
87 } else {
88 /* Root sends data to the first process in the remote group */
89 err = MCA_PML_CALL(send(sbuf, scount*size, sdtype, 0,
90 MCA_COLL_BASE_TAG_SCATTER,
91 MCA_PML_BASE_SEND_STANDARD, comm));
92 if (OMPI_SUCCESS != err) {
93 return err;
94 }
95 }
96
97 return err;
98 }