File: mpi_utils.c

package info (click to toggle)
mpb 1.11.1-3
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 3,856 kB
  • sloc: ansic: 13,270; javascript: 9,901; makefile: 212; lisp: 44; sh: 4
file content (219 lines) | stat: -rw-r--r-- 5,949 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
/* Copyright (C) 1999-2020 Massachusetts Institute of Technology.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

#if !defined(_GNU_SOURCE)
  #define _GNU_SOURCE
#endif

#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>

#include "config.h"
#include <check.h>
#include <mpiglue.h>

#include "mpi_utils.h"

#ifdef HAVE_MPI
MPI_Comm mpb_comm = MPI_COMM_WORLD;
#else
int mpb_comm = 0;
#endif

/* Simple, somewhat hackish API to allow user to run multiple simulations
   in parallel in the same MPI job.  The user calls

   mygroup = divide_parallel_processes(numgroups);

   to divide all of the MPI processes into numgroups equal groups,
   and to return the index (from 0 to numgroups-1) of the current group.
   From this point on, all fields etc. that you create and all
   calls using mpb_comm will only communicate within your group of
   processes.

   However, there are two calls that you can use to switch back to
   globally communication among all processes:

   begin_global_communications();
   ....do stuff....
   end_global_communications();

   It is important not to mix the two types; e.g. you cannot solve
   a field created in the local group in global mode, or vice versa.
*/

#ifdef HAVE_MPI
static MPI_Comm mpb_comm_save = MPI_COMM_WORLD;
#endif

void end_divide_parallel(void)
{
#ifdef HAVE_MPI
    if (mpb_comm != MPI_COMM_WORLD) MPI_Comm_free(&mpb_comm);
    if (mpb_comm_save != MPI_COMM_WORLD) MPI_Comm_free(&mpb_comm_save);
    mpb_comm = mpb_comm_save = MPI_COMM_WORLD;
#endif
}

int divide_parallel_processes(int numgroups)
{
#ifdef HAVE_MPI
    int sz, rank, mygroup;
    end_divide_parallel();
    MPI_Comm_size(mpb_comm, &sz);
    CHECK(numgroups > 0, "numgroups must be > 0");
    CHECK(numgroups <= sz, "tried to split into more groups than processes");
    MPI_Comm_rank(mpb_comm, &rank);
    mygroup = (rank * numgroups) / sz;
    MPI_Comm_split(MPI_COMM_WORLD, mygroup, rank, &mpb_comm);
    return mygroup;
#else
    CHECK(numgroups != 1, "tried to split into more groups than processes");
    return 0;
#endif
}

void begin_global_communications(void)
{
#ifdef HAVE_MPI
    mpb_comm_save = mpb_comm;
    mpb_comm = MPI_COMM_WORLD;
#endif
}

void end_global_communications(void)
{
#ifdef HAVE_MPI
    mpb_comm = mpb_comm_save;
    mpb_comm_save = MPI_COMM_WORLD;
#endif
}

int my_global_rank() {
#ifdef HAVE_MPI
    int rank;
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
    return rank;
#else
    return 0;
#endif
}

/* die when fatal errors occur */
void mpi_die(const char *template, ...)
{
     va_list ap;

     va_start(ap, template);
     vfprintf(stderr, template, ap);
     va_end(ap);

     MPI_Abort(mpb_comm, EXIT_FAILURE);
}

void (*mpb_printf_callback)(const char *s) = NULL;

/* Like printf, except only does anything on master process. */
void mpi_one_printf(const char *template, ...)
{
     if (mpi_is_master()) {
       va_list ap;
       va_start(ap, template);
       if (mpb_printf_callback) {
         char *s;
         vasprintf(&s, template, ap);
         mpb_printf_callback(s);
         free(s);
       }
       else {
         vprintf(template, ap);
       }
       va_end(ap);
       fflush(stdout);
     }
}

/* Like fprintf, except only does anything on master process. */
void mpi_one_fprintf(FILE *f, const char *template, ...)
{
     if (mpi_is_master()) {
       va_list ap;
       va_start(ap, template);
       vfprintf(f, template, ap);
       va_end(ap);
       fflush(f);
     }
}

/* Return whether we are the master process (rank == 0). */
int mpi_is_master(void)
{
     int process_rank;
     MPI_Comm_rank(mpb_comm, &process_rank);
     return (process_rank == 0);
}

/* When debugging, checks to see that x is the same over all processes,
   and abort the program if it is not. */
void mpi_assert_equal(double x)
{
#ifdef DEBUG
     double xmin, xmax;

     mpi_allreduce(&x, &xmin, 1, double, MPI_DOUBLE, MPI_MIN, mpb_comm);
     mpi_allreduce(&x, &xmax, 1, double, MPI_DOUBLE, MPI_MAX, mpb_comm);
     CHECK(xmin == x && xmax == x, "mpi_assert_equal failure");
#else
     (void) x; /* unused */
#endif
}

/* The following functions bracket a "critical section," a region
   of code that should be executed by only one process at a time.

   They work by having each process wait for a message from the
   previous process before starting. 

   Each critical section is passed an integer "tag"...ideally, this
   should be a unique identifier for each critical section so that
   messages from different critical sections don't get mixed up
   somehow. */

void mpi_begin_critical_section(int tag)
{
     int process_rank;
     MPI_Comm_rank(mpb_comm, &process_rank);
     if (process_rank > 0) { /* wait for a message before continuing */
	  MPI_Status status;
	  int recv_tag = tag - 1; /* initialize to wrong value */
	  MPI_Recv(&recv_tag, 1, MPI_INT, process_rank - 1, tag, 
		   mpb_comm, &status);
	  CHECK(recv_tag == tag, "invalid tag received");
     }
}

void mpi_end_critical_section(int tag)
{
     int process_rank, num_procs;
     MPI_Comm_rank(mpb_comm, &process_rank);
     MPI_Comm_size(mpb_comm, &num_procs);
     if (process_rank != num_procs - 1) { /* send a message to next process */
	  MPI_Send(&tag, 1, MPI_INT, process_rank + 1, tag, 
		   mpb_comm);
     }
}