1 /* -*- Mode: C; c-basic-offset:4 ; -*- */
2 /*
3 *
4 * (C) 2001 by Argonne National Laboratory.
5 * See COPYRIGHT in top-level directory.
6 */
7
8 #include "mpiimpl.h"
9 #include "mpicomm.h"
10
11 /* -- Begin Profiling Symbol Block for routine MPI_Comm_group */
12 #if defined(HAVE_PRAGMA_WEAK)
13 #pragma weak MPI_Comm_group = PMPI_Comm_group
14 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
15 #pragma _HP_SECONDARY_DEF PMPI_Comm_group MPI_Comm_group
16 #elif defined(HAVE_PRAGMA_CRI_DUP)
17 #pragma _CRI duplicate MPI_Comm_group as PMPI_Comm_group
18 #endif
19 /* -- End Profiling Symbol Block */
20
21 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
22 the MPI routines */
23 #ifndef MPICH_MPI_FROM_PMPI
24 #undef MPI_Comm_group
25 #define MPI_Comm_group PMPI_Comm_group
26
27 #undef FUNCNAME
28 #define FUNCNAME MPIR_Comm_group_impl
29 #undef FCNAME
30 #define FCNAME MPIU_QUOTE(FUNCNAME)
MPIR_Comm_group_impl(MPID_Comm * comm_ptr,MPID_Group ** group_ptr)31 int MPIR_Comm_group_impl(MPID_Comm *comm_ptr, MPID_Group **group_ptr)
32 {
33 int mpi_errno = MPI_SUCCESS;
34 MPID_VCR *local_vcr;
35 int i, lpid, n;
36 int comm_world_size = MPIR_Process.comm_world->local_size;
37 MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_GROUP_IMPL);
38
39 MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_GROUP_IMPL);
40 /* Create a group if necessary and populate it with the
41 local process ids */
42 if (!comm_ptr->local_group) {
43 n = comm_ptr->local_size;
44 mpi_errno = MPIR_Group_create( n, group_ptr );
45 if (mpi_errno) MPIU_ERR_POP(mpi_errno);
46
47 /* Make sure that we get the correct group */
48 if (comm_ptr->comm_kind == MPID_INTERCOMM) {
49 local_vcr = comm_ptr->local_vcr;
50 }
51 else
52 local_vcr = comm_ptr->vcr;
53
54 (*group_ptr)->is_local_dense_monotonic = TRUE;
55 for (i=0; i<n; i++) {
56 (void) MPID_VCR_Get_lpid( local_vcr[i], &lpid );
57 (*group_ptr)->lrank_to_lpid[i].lrank = i;
58 (*group_ptr)->lrank_to_lpid[i].lpid = lpid;
59 if (lpid > comm_world_size ||
60 (i > 0 && (*group_ptr)->lrank_to_lpid[i-1].lpid != (lpid-1)))
61 {
62 (*group_ptr)->is_local_dense_monotonic = FALSE;
63 }
64 }
65
66 (*group_ptr)->size = n;
67 (*group_ptr)->rank = comm_ptr->rank;
68 (*group_ptr)->idx_of_first_lpid = -1;
69
70 comm_ptr->local_group = *group_ptr;
71 } else {
72 *group_ptr = comm_ptr->local_group;
73 }
74
75 /* FIXME : Add a sanity check that the size of the group is the same as
76 the size of the communicator. This helps catch corrupted
77 communicators */
78
79 MPIR_Group_add_ref( comm_ptr->local_group );
80
81 fn_exit:
82 MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_GROUP_IMPL);
83 return mpi_errno;
84 fn_fail:
85
86 goto fn_exit;
87 }
88
89 #endif
90
91 #undef FUNCNAME
92 #define FUNCNAME MPI_Comm_group
93 #undef FCNAME
94 #define FCNAME MPIU_QUOTE(FUNCNAME)
95 /*@
96
97 MPI_Comm_group - Accesses the group associated with given communicator
98
99 Input Parameter:
100 . comm - Communicator (handle)
101
102 Output Parameter:
103 . group - Group in communicator (handle)
104
105 Notes:
106 .N COMMNULL
107
108 .N ThreadSafe
109
110 .N Fortran
111
112 .N Errors
113 .N MPI_SUCCESS
114 .N MPI_ERR_COMM
115 @*/
MPI_Comm_group(MPI_Comm comm,MPI_Group * group)116 int MPI_Comm_group(MPI_Comm comm, MPI_Group *group)
117 {
118 int mpi_errno = MPI_SUCCESS;
119 MPID_Comm *comm_ptr = NULL;
120 MPID_Group *group_ptr;
121 MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_GROUP);
122
123 MPIR_ERRTEST_INITIALIZED_ORDIE();
124
125 MPIU_THREAD_CS_ENTER(ALLFUNC,);
126 MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_GROUP);
127
128 /* Validate parameters, especially handles needing to be converted */
129 # ifdef HAVE_ERROR_CHECKING
130 {
131 MPID_BEGIN_ERROR_CHECKS;
132 {
133 MPIR_ERRTEST_COMM(comm, mpi_errno);
134 }
135 MPID_END_ERROR_CHECKS;
136 }
137
138 # endif /* HAVE_ERROR_CHECKING */
139
140 /* Convert MPI object handles to object pointers */
141 MPID_Comm_get_ptr( comm, comm_ptr );
142
143 /* Validate parameters and objects (post conversion) */
144 # ifdef HAVE_ERROR_CHECKING
145 {
146 MPID_BEGIN_ERROR_CHECKS;
147 {
148 /* Validate comm_ptr */
149 MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
150 /* If comm_ptr is not valid, it will be reset to null */
151 if (mpi_errno) goto fn_fail;
152 }
153 MPID_END_ERROR_CHECKS;
154 }
155 # endif /* HAVE_ERROR_CHECKING */
156
157 /* ... body of routine ... */
158
159 mpi_errno = MPIR_Comm_group_impl(comm_ptr, &group_ptr);
160 if (mpi_errno) goto fn_fail;
161 *group = group_ptr->handle;
162 /* ... end of body of routine ... */
163
164 fn_exit:
165 MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_GROUP);
166 MPIU_THREAD_CS_EXIT(ALLFUNC,);
167 return mpi_errno;
168
169 fn_fail:
170 /* --BEGIN ERROR HANDLING-- */
171 # ifdef HAVE_ERROR_CHECKING
172 {
173 mpi_errno = MPIR_Err_create_code(
174 mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_comm_group",
175 "**mpi_comm_group %C %p", comm, group);
176 }
177 # endif
178 mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
179 goto fn_exit;
180 /* --END ERROR HANDLING-- */
181 }
182
183