Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
MC: complete workaround in the error msg seen on modern systems
[simgrid.git] / src / smpi / colls / bcast / bcast-SMP-linear.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 #include "../colls_private.hpp"
8
9 int bcast_SMP_linear_segment_byte = 8192;
10 namespace simgrid{
11 namespace smpi{
12 int Coll_bcast_SMP_linear::bcast(void *buf, int count,
13                                      MPI_Datatype datatype, int root,
14                                      MPI_Comm comm)
15 {
16   int tag = COLL_TAG_BCAST;
17   MPI_Status status;
18   MPI_Request request;
19   int rank, size;
20   int i;
21   MPI_Aint extent;
22   extent = datatype->get_extent();
23
24   rank = comm->rank();
25   size = comm->size();
26   if(comm->get_leaders_comm()==MPI_COMM_NULL){
27     comm->init_smp();
28   }
29   int num_core=1;
30   if (comm->is_uniform()){
31     num_core = comm->get_intra_comm()->size();
32   }else{
33     //implementation buggy in this case
34     return Coll_bcast_mpich::bcast( buf , count, datatype,
35               root, comm);
36   }
37
38   int segment = bcast_SMP_linear_segment_byte / extent;
39   segment =  segment == 0 ? 1 :segment;
40   int pipe_length = count / segment;
41   int remainder = count % segment;
42   int increment = segment * extent;
43
44
45   /* leader of each SMP do inter-communication
46      and act as a root for intra-communication */
47   int to_inter = (rank + num_core) % size;
48   int to_intra = (rank + 1) % size;
49   int from_inter = (rank - num_core + size) % size;
50   int from_intra = (rank + size - 1) % size;
51
52   // call native when MPI communication size is too small
53   if (size <= num_core) {
54     XBT_WARN("MPI_bcast_SMP_linear use default MPI_bcast.");
55     Coll_bcast_default::bcast(buf, count, datatype, root, comm);
56     return MPI_SUCCESS;
57   }
58   // if root is not zero send to rank zero first
59   if (root != 0) {
60     if (rank == root)
61       Request::send(buf, count, datatype, 0, tag, comm);
62     else if (rank == 0)
63       Request::recv(buf, count, datatype, root, tag, comm, &status);
64   }
65   // when a message is smaller than a block size => no pipeline
66   if (count <= segment) {
67     // case ROOT
68     if (rank == 0) {
69       Request::send(buf, count, datatype, to_inter, tag, comm);
70       Request::send(buf, count, datatype, to_intra, tag, comm);
71     }
72     // case last ROOT of each SMP
73     else if (rank == (((size - 1) / num_core) * num_core)) {
74       request = Request::irecv(buf, count, datatype, from_inter, tag, comm);
75       Request::wait(&request, &status);
76       Request::send(buf, count, datatype, to_intra, tag, comm);
77     }
78     // case intermediate ROOT of each SMP
79     else if (rank % num_core == 0) {
80       request = Request::irecv(buf, count, datatype, from_inter, tag, comm);
81       Request::wait(&request, &status);
82       Request::send(buf, count, datatype, to_inter, tag, comm);
83       Request::send(buf, count, datatype, to_intra, tag, comm);
84     }
85     // case last non-ROOT of each SMP
86     else if (((rank + 1) % num_core == 0) || (rank == (size - 1))) {
87       request = Request::irecv(buf, count, datatype, from_intra, tag, comm);
88       Request::wait(&request, &status);
89     }
90     // case intermediate non-ROOT of each SMP
91     else {
92       request = Request::irecv(buf, count, datatype, from_intra, tag, comm);
93       Request::wait(&request, &status);
94       Request::send(buf, count, datatype, to_intra, tag, comm);
95     }
96     return MPI_SUCCESS;
97   }
98   // pipeline bcast
99   else {
100     MPI_Request* request_array = new MPI_Request[size + pipe_length];
101     MPI_Status* status_array   = new MPI_Status[size + pipe_length];
102
103     // case ROOT of each SMP
104     if (rank % num_core == 0) {
105       // case real root
106       if (rank == 0) {
107         for (i = 0; i < pipe_length; i++) {
108           Request::send((char *) buf + (i * increment), segment, datatype, to_inter,
109                    (tag + i), comm);
110           Request::send((char *) buf + (i * increment), segment, datatype, to_intra,
111                    (tag + i), comm);
112         }
113       }
114       // case last ROOT of each SMP
115       else if (rank == (((size - 1) / num_core) * num_core)) {
116         for (i = 0; i < pipe_length; i++) {
117           request_array[i] = Request::irecv((char *) buf + (i * increment), segment, datatype,
118                     from_inter, (tag + i), comm);
119         }
120         for (i = 0; i < pipe_length; i++) {
121           Request::wait(&request_array[i], &status);
122           Request::send((char *) buf + (i * increment), segment, datatype, to_intra,
123                    (tag + i), comm);
124         }
125       }
126       // case intermediate ROOT of each SMP
127       else {
128         for (i = 0; i < pipe_length; i++) {
129           request_array[i] = Request::irecv((char *) buf + (i * increment), segment, datatype,
130                     from_inter, (tag + i), comm);
131         }
132         for (i = 0; i < pipe_length; i++) {
133           Request::wait(&request_array[i], &status);
134           Request::send((char *) buf + (i * increment), segment, datatype, to_inter,
135                    (tag + i), comm);
136           Request::send((char *) buf + (i * increment), segment, datatype, to_intra,
137                    (tag + i), comm);
138         }
139       }
140     } else {                    // case last non-ROOT of each SMP
141       if (((rank + 1) % num_core == 0) || (rank == (size - 1))) {
142         for (i = 0; i < pipe_length; i++) {
143           request_array[i] = Request::irecv((char *) buf + (i * increment), segment, datatype,
144                     from_intra, (tag + i), comm);
145         }
146         for (i = 0; i < pipe_length; i++) {
147           Request::wait(&request_array[i], &status);
148         }
149       }
150       // case intermediate non-ROOT of each SMP
151       else {
152         for (i = 0; i < pipe_length; i++) {
153           request_array[i] = Request::irecv((char *) buf + (i * increment), segment, datatype,
154                     from_intra, (tag + i), comm);
155         }
156         for (i = 0; i < pipe_length; i++) {
157           Request::wait(&request_array[i], &status);
158           Request::send((char *) buf + (i * increment), segment, datatype, to_intra,
159                    (tag + i), comm);
160         }
161       }
162     }
163     delete[] request_array;
164     delete[] status_array;
165   }
166
167   // when count is not divisible by block size, use default BCAST for the remainder
168   if ((remainder != 0) && (count > segment)) {
169     XBT_WARN("MPI_bcast_SMP_linear use default MPI_bcast.");
170     Colls::bcast((char *) buf + (pipe_length * increment), remainder, datatype,
171               root, comm);
172   }
173
174   return MPI_SUCCESS;
175 }
176
177 }
178 }