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
|
/*
* Copyright (C) by Argonne National Laboratory
* See COPYRIGHT in top-level directory
*/
#include "mpi.h"
#include <stdio.h>
#include "mpitest.h"
/*
static char MTEST_Descrip[] = "Use Spawn to create an intercomm, then create a new intercomm that includes processes not in the initial spawn intercomm";
*/
/*
* This test ensures that spawned processes are able to communicate with
* processes that were not in the communicator from which they were spawned.
*/
int main(int argc, char *argv[])
{
int errs = 0;
int wrank, wsize;
int np = 2;
int errcodes[2];
MPI_Comm parentcomm, intercomm, intercomm2;
int can_spawn;
MTest_Init(&argc, &argv);
errs += MTestSpawnPossible(&can_spawn);
if (can_spawn) {
MPI_Comm_rank(MPI_COMM_WORLD, &wrank);
MPI_Comm_size(MPI_COMM_WORLD, &wsize);
MPI_Comm_get_parent(&parentcomm);
if (parentcomm == MPI_COMM_NULL) {
/* Create 2 more processes, from process 0 in the original
* comm world */
if (wrank == 0) {
MPI_Comm_spawn((char *) "./spaiccreate", MPI_ARGV_NULL, np,
MPI_INFO_NULL, 0, MPI_COMM_SELF, &intercomm, errcodes);
} else {
intercomm = MPI_COMM_NULL;
}
} else
intercomm = parentcomm;
/* We now have a valid intercomm. Use it to create a NEW intercomm
* that includes all processes */
MPI_Intercomm_create(MPI_COMM_WORLD, 0, intercomm, 0, 123, &intercomm2);
/* Have the spawned processes send to rank 1 in the comm world of the
* parent */
if (parentcomm == MPI_COMM_NULL) {
MPI_Send(&wrank, 1, MPI_INT, 1, wrank, intercomm2);
} else {
if (wrank == 1) {
int i, rsize, rrank;
MPI_Status status;
MPI_Comm_remote_size(intercomm2, &rsize);
for (i = 0; i < rsize; i++) {
MPI_Recv(&rrank, 1, MPI_INT, i, i, intercomm2, &status);
if (rrank != i) {
errs++;
printf("Received %d from %d; expected %d\n", rrank, i, i);
}
}
}
}
/* printf("%sAbout to barrier on intercomm2\n",
* (parentcomm == MPI_COMM_NULL) ? "<orig>" : "<spawned>");
* fflush(stdout); */
MPI_Barrier(intercomm2);
/* It isn't necessary to free the intercomms, but it should not hurt */
if (intercomm != MPI_COMM_NULL)
MPI_Comm_free(&intercomm);
MPI_Comm_free(&intercomm2);
/* Note that the MTest_Finalize get errs only over COMM_WORLD */
/* Note also that both the parent and child will generate "No Errors"
* if both call MTest_Finalize */
if (parentcomm == MPI_COMM_NULL) {
MTest_Finalize(errs);
} else {
MPI_Finalize();
}
} else {
MTest_Finalize(errs);
}
return MTestReturnValue(errs);
}
|
