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 MPIX_Comm_split_type */
12 #if defined(HAVE_PRAGMA_WEAK)
13 #pragma weak MPIX_Comm_split_type = PMPIX_Comm_split_type
14 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
15 #pragma _HP_SECONDARY_DEF PMPIX_Comm_split_type MPIX_Comm_split_type
16 #elif defined(HAVE_PRAGMA_CRI_DUP)
17 #pragma _CRI duplicate MPIX_Comm_split_type as PMPIX_Comm_split_type
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 MPIX_Comm_split_type
25 #define MPIX_Comm_split_type PMPIX_Comm_split_type
26 #endif
27
28 #undef FUNCNAME
29 #define FUNCNAME MPIR_Comm_split_type_impl
30 #undef FCNAME
31 #define FCNAME MPIU_QUOTE(FUNCNAME)
MPIR_Comm_split_type_impl(MPID_Comm * comm_ptr,int split_type,int key,MPID_Info * info_ptr,MPID_Comm ** newcomm_ptr)32 int MPIR_Comm_split_type_impl(MPID_Comm * comm_ptr, int split_type, int key,
33 MPID_Info * info_ptr, MPID_Comm ** newcomm_ptr)
34 {
35 int mpi_errno = MPI_SUCCESS;
36
37 MPIU_Assert(split_type == MPIX_COMM_TYPE_SHARED);
38
39 if (MPID_Comm_fns == NULL || MPID_Comm_fns->split_type == NULL) {
40 /* Default implementation is to just return MPI_COMM_SELF */
41 mpi_errno = MPIR_Comm_split_impl(comm_ptr, comm_ptr->rank, key, newcomm_ptr);
42 }
43 else {
44 mpi_errno =
45 MPID_Comm_fns->split_type(comm_ptr, split_type, key, info_ptr, newcomm_ptr);
46 }
47 if (mpi_errno)
48 MPIU_ERR_POP(mpi_errno);
49
50 fn_exit:
51 return mpi_errno;
52 fn_fail:
53 goto fn_exit;
54 }
55
56
57 #undef FUNCNAME
58 #define FUNCNAME MPIX_Comm_split_type
59 #undef FCNAME
60 #define FCNAME MPIU_QUOTE(FUNCNAME)
61 /*@
62
63 MPIX_Comm_split_type - Creates new communicators based on split types and keys
64
65 Input Parameters:
66 + comm - communicator (handle)
67 . split_type - type of processes to be grouped together (nonnegative integer).
68 . key - control of rank assigment (integer)
69 - info - hints to improve communicator creation (handle)
70
71 Output Parameter:
72 . newcomm - new communicator (handle)
73
74 Notes:
75 The 'split_type' must be non-negative or 'MPI_UNDEFINED'.
76
77 .N ThreadSafe
78
79 .N Fortran
80
81 .N Errors
82 .N MPI_SUCCESS
83 .N MPI_ERR_COMM
84 .N MPI_ERR_EXHAUSTED
85
86 .seealso: MPI_Comm_free
87 @*/
MPIX_Comm_split_type(MPI_Comm comm,int split_type,int key,MPI_Info info,MPI_Comm * newcomm)88 int MPIX_Comm_split_type(MPI_Comm comm, int split_type, int key, MPI_Info info,
89 MPI_Comm * newcomm)
90 {
91 int mpi_errno = MPI_SUCCESS;
92 MPID_Comm *comm_ptr = NULL, *newcomm_ptr;
93 MPID_Info *info_ptr = NULL;
94 MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_SPLIT_TYPE);
95
96 MPIR_ERRTEST_INITIALIZED_ORDIE();
97
98 MPIU_THREAD_CS_ENTER(ALLFUNC,);
99 MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_SPLIT_TYPE);
100
101 /* Validate parameters, especially handles needing to be converted */
102 #ifdef HAVE_ERROR_CHECKING
103 {
104 MPID_BEGIN_ERROR_CHECKS;
105 {
106 MPIR_ERRTEST_COMM(comm, mpi_errno);
107 }
108 MPID_END_ERROR_CHECKS;
109 }
110
111 #endif /* HAVE_ERROR_CHECKING */
112
113 /* Get handles to MPI objects. */
114 MPID_Comm_get_ptr(comm, comm_ptr);
115 MPID_Info_get_ptr(info, info_ptr);
116
117 /* Validate parameters and objects (post conversion) */
118 #ifdef HAVE_ERROR_CHECKING
119 {
120 MPID_BEGIN_ERROR_CHECKS;
121 {
122 /* Validate comm_ptr */
123 MPID_Comm_valid_ptr(comm_ptr, mpi_errno);
124 /* If comm_ptr is not valid, it will be reset to null */
125 if (mpi_errno)
126 goto fn_fail;
127 }
128 MPID_END_ERROR_CHECKS;
129 }
130 #endif /* HAVE_ERROR_CHECKING */
131
132 /* ... body of routine ... */
133
134 mpi_errno = MPIR_Comm_split_type_impl(comm_ptr, split_type, key, info_ptr, &newcomm_ptr);
135 if (mpi_errno)
136 MPIU_ERR_POP(mpi_errno);
137 if (newcomm_ptr)
138 MPIU_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle);
139 else
140 *newcomm = MPI_COMM_NULL;
141
142 /* ... end of body of routine ... */
143
144 fn_exit:
145 MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_SPLIT_TYPE);
146 MPIU_THREAD_CS_EXIT(ALLFUNC,);
147 return mpi_errno;
148
149 fn_fail:
150 /* --BEGIN ERROR HANDLING-- */
151 #ifdef HAVE_ERROR_CHECKING
152 {
153 /* FIXME this error code is wrong, it's the error code for
154 * regular MPI_Comm_split */
155 mpi_errno =
156 MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__,
157 MPI_ERR_OTHER, "**mpi_comm_split",
158 "**mpi_comm_split %C %d %d %p", comm, split_type, key,
159 newcomm);
160 }
161 #endif
162 mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
163 goto fn_exit;
164 /* --END ERROR HANDLING-- */
165 }
166