1 /*
2 (C) 2004 by Argonne National Laboratory.
3 See COPYRIGHT in top-level directory.
4 */
5 #include "collchk.h"
6
CollChk_same_call(MPI_Comm comm,char * call)7 int CollChk_same_call(MPI_Comm comm, char* call)
8 {
9 int r, s, i, go, ok; /* rank, size, counter, go flag, ok flag */
10 char buff[COLLCHK_SM_STRLEN]; /* temp communication buffer */
11 char err_str[COLLCHK_STD_STRLEN]; /* error string */
12 MPI_Status st;int tag=0; /* needed for communication */
13 int inter; /* flag for inter or intra communicator */
14 MPI_Comm usecomm; /* needed if intercommunicator */
15
16 /* set the error string */
17 sprintf(err_str, COLLCHK_NO_ERROR_STR);
18
19 /* test if the communicator is intra of inter */
20 MPI_Comm_test_inter(comm, &inter);
21 /* if inter then convert to intra */
22 if(inter) {
23 PMPI_Intercomm_merge(comm, 0, &usecomm);
24 }
25 else {
26 usecomm = comm;
27 }
28
29 /* get rank and size */
30 MPI_Comm_rank(usecomm, &r);
31 MPI_Comm_size(usecomm, &s);
32
33 if (r == 0) {
34 /* send the name of the call to the other processes */
35 strcpy(buff, call);
36 PMPI_Bcast(buff, COLLCHK_SM_STRLEN, MPI_CHAR, 0, usecomm);
37 /* ask the other processes if they are ok to continue */
38 go = 1; /* sets the go flag */
39 for (i=1; i<s; i++) {
40 MPI_Recv(&ok, 1, MPI_INT, i, tag, usecomm, &st);
41 /* if a process has made a bad call unset the go flag */
42 if (!ok)
43 go = 0;
44 }
45
46 /* broadcast to the go flag */
47 PMPI_Bcast(&go, 1, MPI_INT, 0, usecomm);
48 }
49 else {
50 /* recieve 0's call name */
51 PMPI_Bcast(buff, COLLCHK_SM_STRLEN, MPI_CHAR, 0, usecomm);
52 /* check it against the local call name */
53 if (strcmp(buff, call) != 0) {
54 /* at this point the call is not consistant */
55 /* print an error message and send a unset ok flag to 0 */
56 ok = 0;
57 sprintf(err_str, "Collective call (%s) is Inconsistent with "
58 "Rank 0's (%s).", call, buff);
59 MPI_Send(&ok, 1, MPI_INT, 0, tag, usecomm);
60 }
61 else {
62 /* at this point the call is consistant */
63 /* send an set ok flag to 0 */
64 ok = 1;
65 MPI_Send(&ok, 1, MPI_INT, 0, tag, usecomm);
66 }
67 /* get the go flag from 0 */
68 PMPI_Bcast(&go, 1, MPI_INT, 0, usecomm);
69 }
70 /* if the go flag is not set exit else return */
71 if(!go) {
72 return CollChk_err_han(err_str, COLLCHK_ERR_CALL, call, usecomm);
73 }
74
75 return MPI_SUCCESS;
76 }
77