Add support for MPI-3's MPI_COMM_SPLIT_TYPE function
This commit was SVN r25738.
Этот коммит содержится в:
Brian Barrett
родитель
9d556e2f17
Коммит
b2411fe131
@ -631,6 +631,260 @@ int ompi_comm_split ( ompi_communicator_t* comm, int color, int key,
|
||||
*newcomm = newcomp;
|
||||
return ( rc );
|
||||
}
|
||||
|
||||
|
||||
/**********************************************************************/
|
||||
/**********************************************************************/
|
||||
/**********************************************************************/
|
||||
int
|
||||
ompi_comm_split_type(ompi_communicator_t *comm,
|
||||
int split_type, int key,
|
||||
ompi_info_t *info,
|
||||
ompi_communicator_t** newcomm)
|
||||
{
|
||||
int myinfo[2];
|
||||
int size, my_size;
|
||||
int my_rsize;
|
||||
int mode;
|
||||
int rsize;
|
||||
int i, loc;
|
||||
int inter;
|
||||
int *results=NULL, *sorted=NULL;
|
||||
int *rresults=NULL, *rsorted=NULL;
|
||||
int rc=OMPI_SUCCESS;
|
||||
ompi_communicator_t *newcomp = NULL;
|
||||
int *lranks=NULL, *rranks=NULL;
|
||||
|
||||
ompi_comm_allgatherfct *allgatherfct=NULL;
|
||||
|
||||
/* Step 1: determine all the information for the local group */
|
||||
/* --------------------------------------------------------- */
|
||||
|
||||
/* sort according to participation and rank. Gather information from everyone */
|
||||
myinfo[0] = (split_type == MPI_COMM_TYPE_SHARED) ? 1 : 0;
|
||||
myinfo[1] = key;
|
||||
|
||||
size = ompi_comm_size ( comm );
|
||||
inter = OMPI_COMM_IS_INTER(comm);
|
||||
if ( inter ) {
|
||||
allgatherfct = (ompi_comm_allgatherfct *)ompi_comm_allgather_emulate_intra;
|
||||
} else {
|
||||
allgatherfct = (ompi_comm_allgatherfct *)comm->c_coll.coll_allgather;
|
||||
}
|
||||
|
||||
results = (int*) malloc ( 2 * size * sizeof(int));
|
||||
if ( NULL == results ) {
|
||||
return OMPI_ERR_OUT_OF_RESOURCE;
|
||||
}
|
||||
|
||||
rc = allgatherfct( myinfo, 2, MPI_INT, results, 2, MPI_INT, comm, comm->c_coll.coll_allgather_module );
|
||||
if ( OMPI_SUCCESS != rc ) {
|
||||
goto exit;
|
||||
}
|
||||
|
||||
/* how many are participating and on my node? */
|
||||
for ( my_size = 0, i=0; i < size; i++) {
|
||||
if ( results[(2*i)+0] == 1) {
|
||||
if (OPAL_PROC_ON_LOCAL_NODE(ompi_group_peer_lookup(comm->c_local_group, i)->proc_flags)) {
|
||||
my_size++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sorted = (int *) malloc ( sizeof( int ) * my_size * 2);
|
||||
if ( NULL == sorted) {
|
||||
rc = OMPI_ERR_OUT_OF_RESOURCE;
|
||||
goto exit;
|
||||
}
|
||||
|
||||
/* ok we can now fill this info */
|
||||
for( loc = 0, i = 0; i < size; i++ ) {
|
||||
if ( results[(2*i)+0] == 1) {
|
||||
if (OPAL_PROC_ON_LOCAL_NODE(ompi_group_peer_lookup(comm->c_local_group, i)->proc_flags)) {
|
||||
sorted[(2*loc)+0] = i; /* copy org rank */
|
||||
sorted[(2*loc)+1] = results[(2*i)+1]; /* copy key */
|
||||
loc++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* the new array needs to be sorted so that it is in 'key' order */
|
||||
/* if two keys are equal then it is sorted in original rank order! */
|
||||
if(my_size>1){
|
||||
qsort ((int*)sorted, my_size, sizeof(int)*2, rankkeycompare);
|
||||
}
|
||||
|
||||
/* put group elements in a list */
|
||||
lranks = (int *) malloc ( my_size * sizeof(int));
|
||||
if ( NULL == lranks ) {
|
||||
rc = OMPI_ERR_OUT_OF_RESOURCE;
|
||||
goto exit;
|
||||
}
|
||||
for (i = 0; i < my_size; i++) {
|
||||
lranks[i] = sorted[i*2];
|
||||
}
|
||||
|
||||
/* Step 2: determine all the information for the remote group */
|
||||
/* --------------------------------------------------------- */
|
||||
if ( inter ) {
|
||||
rsize = comm->c_remote_group->grp_proc_count;
|
||||
rresults = (int *) malloc ( rsize * 2 * sizeof(int));
|
||||
if ( NULL == rresults ) {
|
||||
rc = OMPI_ERR_OUT_OF_RESOURCE;
|
||||
goto exit;
|
||||
}
|
||||
|
||||
/* this is an allgather on an inter-communicator */
|
||||
rc = comm->c_coll.coll_allgather( myinfo, 2, MPI_INT, rresults, 2,
|
||||
MPI_INT, comm,
|
||||
comm->c_coll.coll_allgather_module);
|
||||
if ( OMPI_SUCCESS != rc ) {
|
||||
goto exit;
|
||||
}
|
||||
|
||||
/* how many are participating and on my node? */
|
||||
for ( my_rsize = 0, i=0; i < rsize; i++) {
|
||||
if ( rresults[(2*i)+0] == 1) {
|
||||
if (OPAL_PROC_ON_LOCAL_NODE(ompi_group_peer_lookup(comm->c_remote_group, i)->proc_flags)) {
|
||||
my_rsize++;
|
||||
}
|
||||
}
|
||||
}
|
||||
rsorted = (int *) malloc ( sizeof( int ) * my_rsize * 2);
|
||||
if ( NULL == rsorted) {
|
||||
rc = OMPI_ERR_OUT_OF_RESOURCE;
|
||||
goto exit;
|
||||
}
|
||||
|
||||
/* ok we can now fill this info */
|
||||
for( loc = 0, i = 0; i < rsize; i++ ) {
|
||||
if ( rresults[(2*i)+0] == 1) {
|
||||
if (OPAL_PROC_ON_LOCAL_NODE(ompi_group_peer_lookup(comm->c_remote_group, i)->proc_flags)) {
|
||||
rsorted[(2*loc)+0] = i; /* org rank */
|
||||
rsorted[(2*loc)+1] = rresults[(2*i)+1]; /* key */
|
||||
loc++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* the new array needs to be sorted so that it is in 'key' order */
|
||||
/* if two keys are equal then it is sorted in original rank order! */
|
||||
if(my_rsize>1) {
|
||||
qsort ((int*)rsorted, my_rsize, sizeof(int)*2, rankkeycompare);
|
||||
}
|
||||
|
||||
/* put group elements in a list */
|
||||
rranks = (int *) malloc ( my_rsize * sizeof(int));
|
||||
if ( NULL == rranks) {
|
||||
rc = OMPI_ERR_OUT_OF_RESOURCE;
|
||||
goto exit;
|
||||
}
|
||||
|
||||
for (i = 0; i < my_rsize; i++) {
|
||||
rranks[i] = rsorted[i*2];
|
||||
}
|
||||
mode = OMPI_COMM_CID_INTER;
|
||||
} else {
|
||||
my_rsize = 0;
|
||||
rranks = NULL;
|
||||
mode = OMPI_COMM_CID_INTRA;
|
||||
}
|
||||
|
||||
|
||||
/* Step 3: set up the communicator */
|
||||
/* --------------------------------------------------------- */
|
||||
/* Create the communicator finally */
|
||||
|
||||
rc = ompi_comm_set ( &newcomp, /* new comm */
|
||||
comm, /* old comm */
|
||||
my_size, /* local_size */
|
||||
lranks, /* local_ranks */
|
||||
my_rsize, /* remote_size */
|
||||
rranks, /* remote_ranks */
|
||||
NULL, /* attrs */
|
||||
comm->error_handler,/* error handler */
|
||||
NULL, /* topo component */
|
||||
NULL, /* local group */
|
||||
NULL /* remote group */
|
||||
);
|
||||
|
||||
if ( NULL == newcomm ) {
|
||||
rc = MPI_ERR_INTERN;
|
||||
goto exit;
|
||||
}
|
||||
if ( OMPI_SUCCESS != rc ) {
|
||||
goto exit;
|
||||
}
|
||||
|
||||
/* Determine context id. It is identical to f_2_c_handle */
|
||||
rc = ompi_comm_nextcid ( newcomp, /* new communicator */
|
||||
comm, /* old comm */
|
||||
NULL, /* bridge comm */
|
||||
NULL, /* local leader */
|
||||
NULL, /* remote_leader */
|
||||
mode, /* mode */
|
||||
-1 ); /* send first, doesn't matter */
|
||||
if ( OMPI_SUCCESS != rc ) {
|
||||
goto exit;
|
||||
}
|
||||
|
||||
/* Set name for debugging purposes */
|
||||
snprintf(newcomp->c_name, MPI_MAX_OBJECT_NAME, "MPI COMMUNICATOR %d SPLIT_TYPE FROM %d",
|
||||
newcomp->c_contextid, comm->c_contextid );
|
||||
|
||||
/* set the rank to MPI_UNDEFINED. This prevents in comm_activate
|
||||
* the collective module selection for a communicator that will
|
||||
* be freed anyway.
|
||||
*/
|
||||
if ( MPI_UNDEFINED == split_type ) {
|
||||
newcomp->c_local_group->grp_my_rank = MPI_UNDEFINED;
|
||||
}
|
||||
|
||||
|
||||
/* Activate the communicator and init coll-component */
|
||||
rc = ompi_comm_activate( &newcomp, /* new communicator */
|
||||
comm,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
mode,
|
||||
-1 );
|
||||
if ( OMPI_SUCCESS != rc ) {
|
||||
goto exit;
|
||||
}
|
||||
|
||||
exit:
|
||||
if ( NULL != results ) {
|
||||
free ( results );
|
||||
}
|
||||
if ( NULL != sorted ) {
|
||||
free ( sorted );
|
||||
}
|
||||
if ( NULL != rresults) {
|
||||
free ( rresults );
|
||||
}
|
||||
if ( NULL != rsorted ) {
|
||||
free ( rsorted );
|
||||
}
|
||||
if ( NULL != lranks ) {
|
||||
free ( lranks );
|
||||
}
|
||||
if ( NULL != rranks ) {
|
||||
free ( rranks );
|
||||
}
|
||||
|
||||
/* Step 4: if we are not part of the comm, free the struct */
|
||||
/* --------------------------------------------------------- */
|
||||
if ( NULL != newcomp && MPI_UNDEFINED == split_type ) {
|
||||
ompi_comm_free ( &newcomp );
|
||||
}
|
||||
|
||||
*newcomm = newcomp;
|
||||
return ( rc );
|
||||
}
|
||||
|
||||
|
||||
|
||||
/**********************************************************************/
|
||||
/**********************************************************************/
|
||||
/**********************************************************************/
|
||||
|
||||
@ -378,6 +378,21 @@ int ompi_topo_create (ompi_communicator_t *old_comm,
|
||||
OMPI_DECLSPEC int ompi_comm_split (ompi_communicator_t *comm, int color, int key,
|
||||
ompi_communicator_t** newcomm, bool pass_on_topo);
|
||||
|
||||
/**
|
||||
* split a communicator based on type and key. Parameters
|
||||
* are identical to the MPI-counterpart of the function.
|
||||
*
|
||||
* @param comm: input communicator
|
||||
* @param color
|
||||
* @param key
|
||||
*
|
||||
* @
|
||||
*/
|
||||
OMPI_DECLSPEC int ompi_comm_split_type(ompi_communicator_t *comm,
|
||||
int split_type, int key,
|
||||
struct ompi_info_t *info,
|
||||
ompi_communicator_t** newcomm);
|
||||
|
||||
/**
|
||||
* dup a communicator. Parameter are identical to the MPI-counterpart
|
||||
* of the function. It has been extracted, since we need to be able
|
||||
|
||||
@ -614,6 +614,15 @@ enum {
|
||||
MPI_COMBINER_RESIZED
|
||||
};
|
||||
|
||||
/*
|
||||
* Communicator split type constants.
|
||||
* Do not change the order of these without also modifying mpif.h.in.
|
||||
*/
|
||||
enum {
|
||||
MPI_COMM_TYPE_SHARED
|
||||
};
|
||||
|
||||
|
||||
/*
|
||||
* NULL handles
|
||||
*/
|
||||
@ -1118,6 +1127,7 @@ OMPI_DECLSPEC int MPI_Comm_spawn_multiple(int count, char **array_of_commands,
|
||||
int root, MPI_Comm comm, MPI_Comm *intercomm,
|
||||
int *array_of_errcodes);
|
||||
OMPI_DECLSPEC int MPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm *newcomm);
|
||||
OMPI_DECLSPEC int MPI_Comm_split_type(MPI_Comm comm, int split_type, int key, MPI_Info info, MPI_Comm *newcomm);
|
||||
OMPI_DECLSPEC int MPI_Comm_test_inter(MPI_Comm comm, int *flag);
|
||||
OMPI_DECLSPEC int MPI_Dims_create(int nnodes, int ndims, int *dims);
|
||||
OMPI_DECLSPEC MPI_Fint MPI_Errhandler_c2f(MPI_Errhandler errhandler);
|
||||
@ -1644,6 +1654,7 @@ OMPI_DECLSPEC int PMPI_Comm_spawn_multiple(int count, char **array_of_commands,
|
||||
int root, MPI_Comm comm, MPI_Comm *intercomm,
|
||||
int *array_of_errcodes);
|
||||
OMPI_DECLSPEC int PMPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm *newcomm);
|
||||
OMPI_DECLSPEC int PMPI_Comm_split_type(MPI_Comm comm, int split_type, int key, MPI_Info info, MPI_Comm *newcomm);
|
||||
OMPI_DECLSPEC int PMPI_Comm_test_inter(MPI_Comm comm, int *flag);
|
||||
OMPI_DECLSPEC int PMPI_Dims_create(int nnodes, int ndims, int *dims);
|
||||
OMPI_DECLSPEC MPI_Fint PMPI_Errhandler_c2f(MPI_Errhandler errhandler);
|
||||
|
||||
@ -12,6 +12,7 @@
|
||||
! All rights reserved.
|
||||
! Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
|
||||
! Copyright (c) 2009 Oak Ridge National Labs. All rights reserved.
|
||||
! Copyright (c) 2012 Sandia National Laboratories. All rights reserved.
|
||||
! $COPYRIGHT$
|
||||
!
|
||||
! Additional copyrights may follow
|
||||
@ -385,6 +386,13 @@
|
||||
parameter (MPI_COMBINER_F90_COMPLEX=15)
|
||||
parameter (MPI_COMBINER_F90_INTEGER=16)
|
||||
parameter (MPI_COMBINER_RESIZED=17)
|
||||
|
||||
!
|
||||
! Communicator split type constants
|
||||
!
|
||||
integer MPI_COMM_TYPE_SHARED
|
||||
parameter (MPI_COMM_TYPE_SHARED=0)
|
||||
|
||||
!
|
||||
! lookup table indices
|
||||
!
|
||||
|
||||
@ -119,6 +119,7 @@ libmpi_c_mpi_la_SOURCES = \
|
||||
comm_spawn.c \
|
||||
comm_spawn_multiple.c \
|
||||
comm_split.c \
|
||||
comm_split_type.c \
|
||||
comm_test_inter.c \
|
||||
dims_create.c \
|
||||
errhandler_c2f.c \
|
||||
|
||||
81
ompi/mpi/c/comm_split_type.c
Обычный файл
81
ompi/mpi/c/comm_split_type.c
Обычный файл
@ -0,0 +1,81 @@
|
||||
/*
|
||||
* Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana
|
||||
* University Research and Technology
|
||||
* Corporation. All rights reserved.
|
||||
* Copyright (c) 2004-2005 The University of Tennessee and The University
|
||||
* of Tennessee Research Foundation. All rights
|
||||
* reserved.
|
||||
* Copyright (c) 2004-2008 High Performance Computing Center Stuttgart,
|
||||
* University of Stuttgart. All rights reserved.
|
||||
* Copyright (c) 2004-2005 The Regents of the University of California.
|
||||
* All rights reserved.
|
||||
* Copyright (c) 2006 Cisco Systems, Inc. All rights reserved.
|
||||
* Copyright (c) 2012 Sandia National Laboratories. All rights reserved.
|
||||
* $COPYRIGHT$
|
||||
*
|
||||
* Additional copyrights may follow
|
||||
*
|
||||
* $HEADER$
|
||||
*/
|
||||
|
||||
#include "ompi_config.h"
|
||||
#include <stdio.h>
|
||||
|
||||
#include "ompi/mpi/c/bindings.h"
|
||||
#include "ompi/runtime/params.h"
|
||||
#include "ompi/communicator/communicator.h"
|
||||
#include "ompi/errhandler/errhandler.h"
|
||||
#include "ompi/info/info.h"
|
||||
#include "ompi/memchecker.h"
|
||||
|
||||
#if OPAL_HAVE_WEAK_SYMBOLS && OMPI_PROFILING_DEFINES
|
||||
#pragma weak MPI_Comm_split_type = PMPI_Comm_split_type
|
||||
#endif
|
||||
|
||||
#if OMPI_PROFILING_DEFINES
|
||||
#include "ompi/mpi/c/profile/defines.h"
|
||||
#endif
|
||||
|
||||
static const char FUNC_NAME[] = "MPI_Comm_split_type";
|
||||
|
||||
|
||||
int MPI_Comm_split_type(MPI_Comm comm, int split_type, int key,
|
||||
MPI_Info info, MPI_Comm *newcomm) {
|
||||
|
||||
int rc;
|
||||
|
||||
MEMCHECKER(
|
||||
memchecker_comm(comm);
|
||||
);
|
||||
|
||||
if ( MPI_PARAM_CHECK ) {
|
||||
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
|
||||
|
||||
if ( ompi_comm_invalid ( comm )) {
|
||||
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_COMM,
|
||||
FUNC_NAME);
|
||||
}
|
||||
|
||||
if (NULL == info || ompi_info_is_freed(info)) {
|
||||
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO,
|
||||
FUNC_NAME);
|
||||
}
|
||||
|
||||
if ( MPI_COMM_TYPE_SHARED != split_type &&
|
||||
MPI_UNDEFINED != split_type ) {
|
||||
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
|
||||
FUNC_NAME);
|
||||
}
|
||||
|
||||
if ( NULL == newcomm ) {
|
||||
return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
|
||||
FUNC_NAME);
|
||||
}
|
||||
}
|
||||
|
||||
OPAL_CR_ENTER_LIBRARY();
|
||||
|
||||
rc = ompi_comm_split_type ( (ompi_communicator_t*)comm, split_type, key, info,
|
||||
(ompi_communicator_t**)newcomm);
|
||||
OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME);
|
||||
}
|
||||
@ -101,6 +101,7 @@ nodist_libmpi_c_pmpi_la_SOURCES = \
|
||||
pcomm_spawn.c \
|
||||
pcomm_spawn_multiple.c \
|
||||
pcomm_split.c \
|
||||
pcomm_split_type.c \
|
||||
pcomm_test_inter.c \
|
||||
pdims_create.c \
|
||||
perrhandler_c2f.c \
|
||||
|
||||
@ -87,6 +87,7 @@
|
||||
#define MPI_Comm_spawn PMPI_Comm_spawn
|
||||
#define MPI_Comm_spawn_multiple PMPI_Comm_spawn_multiple
|
||||
#define MPI_Comm_split PMPI_Comm_split
|
||||
#define MPI_Comm_split_type PMPI_Comm_split_type
|
||||
#define MPI_Comm_test_inter PMPI_Comm_test_inter
|
||||
#define MPI_Dims_create PMPI_Dims_create
|
||||
#define MPI_Errhandler_c2f PMPI_Errhandler_c2f
|
||||
|
||||
@ -137,6 +137,7 @@ libmpi_f77_la_SOURCES += \
|
||||
comm_spawn_f.c \
|
||||
comm_spawn_multiple_f.c \
|
||||
comm_split_f.c \
|
||||
comm_split_type_f.c \
|
||||
comm_test_inter_f.c \
|
||||
dims_create_f.c \
|
||||
errhandler_create_f.c \
|
||||
|
||||
78
ompi/mpi/f77/comm_split_type_f.c
Обычный файл
78
ompi/mpi/f77/comm_split_type_f.c
Обычный файл
@ -0,0 +1,78 @@
|
||||
/*
|
||||
* Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
|
||||
* University Research and Technology
|
||||
* Corporation. All rights reserved.
|
||||
* Copyright (c) 2004-2005 The University of Tennessee and The University
|
||||
* of Tennessee Research Foundation. All rights
|
||||
* reserved.
|
||||
* Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
|
||||
* University of Stuttgart. All rights reserved.
|
||||
* Copyright (c) 2004-2005 The Regents of the University of California.
|
||||
* All rights reserved.
|
||||
* Copyright (c) 2012 Sandia National Laboratories. All rights reserved.
|
||||
* $COPYRIGHT$
|
||||
*
|
||||
* Additional copyrights may follow
|
||||
*
|
||||
* $HEADER$
|
||||
*/
|
||||
|
||||
#include "ompi_config.h"
|
||||
|
||||
#include "ompi/mpi/f77/bindings.h"
|
||||
|
||||
#if OPAL_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
|
||||
#pragma weak PMPI_COMM_SPLIT_TYPE = mpi_comm_split_type_f
|
||||
#pragma weak pmpi_comm_split_type = mpi_comm_split_type_f
|
||||
#pragma weak pmpi_comm_split_type_ = mpi_comm_split_type_f
|
||||
#pragma weak pmpi_comm_split_type__ = mpi_comm_split_type_f
|
||||
#elif OMPI_PROFILE_LAYER
|
||||
OMPI_GENERATE_F77_BINDINGS (PMPI_COMM_SPLIT_TYPE,
|
||||
pmpi_comm_split_type,
|
||||
pmpi_comm_split_type_,
|
||||
pmpi_comm_split_type__,
|
||||
pmpi_comm_split_type_f,
|
||||
(MPI_Fint *comm, MPI_Fint *color, MPI_Fint *key, MPI_Fint *newcomm, MPI_Fint *ierr),
|
||||
(comm, color, key, newcomm, ierr) )
|
||||
#endif
|
||||
|
||||
#if OPAL_HAVE_WEAK_SYMBOLS
|
||||
#pragma weak MPI_COMM_SPLIT_TYPE = mpi_comm_split_type_f
|
||||
#pragma weak mpi_comm_split_type = mpi_comm_split_type_f
|
||||
#pragma weak mpi_comm_split_type_ = mpi_comm_split_type_f
|
||||
#pragma weak mpi_comm_split_type__ = mpi_comm_split_type_f
|
||||
#endif
|
||||
|
||||
#if ! OPAL_HAVE_WEAK_SYMBOLS && ! OMPI_PROFILE_LAYER
|
||||
OMPI_GENERATE_F77_BINDINGS (MPI_COMM_SPLIT_TYPE,
|
||||
mpi_comm_split_type,
|
||||
mpi_comm_split_type_,
|
||||
mpi_comm_split_type__,
|
||||
mpi_comm_split_type_f,
|
||||
(MPI_Fint *comm, MPI_Fint *color, MPI_Fint *key, MPI_Fint *newcomm, MPI_Fint *ierr),
|
||||
(comm, color, key, newcomm, ierr) )
|
||||
#endif
|
||||
|
||||
|
||||
#if OMPI_PROFILE_LAYER && ! OPAL_HAVE_WEAK_SYMBOLS
|
||||
#include "ompi/mpi/f77/profile/defines.h"
|
||||
#endif
|
||||
|
||||
void mpi_comm_split_type_f(MPI_Fint *comm, MPI_Fint *split_type, MPI_Fint *key,
|
||||
MPI_Fint *info, MPI_Fint *newcomm, MPI_Fint *ierr)
|
||||
{
|
||||
MPI_Comm c_newcomm;
|
||||
MPI_Comm c_comm = MPI_Comm_f2c ( *comm );
|
||||
MPI_Info c_info;
|
||||
|
||||
c_info = MPI_Info_f2c(*info);
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Comm_split_type(c_comm,
|
||||
OMPI_FINT_2_INT(*split_type),
|
||||
OMPI_FINT_2_INT(*key),
|
||||
c_info,
|
||||
&c_newcomm ));
|
||||
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
|
||||
*newcomm = MPI_Comm_c2f (c_newcomm);
|
||||
}
|
||||
}
|
||||
@ -102,6 +102,7 @@ nodist_libmpi_f77_pmpi_la_SOURCES = \
|
||||
pcomm_spawn_f.c \
|
||||
pcomm_spawn_multiple_f.c \
|
||||
pcomm_split_f.c \
|
||||
pcomm_split_type_f.c \
|
||||
pcomm_test_inter_f.c \
|
||||
pdims_create_f.c \
|
||||
perrhandler_create_f.c \
|
||||
|
||||
@ -79,6 +79,7 @@
|
||||
#define mpi_comm_spawn_f pmpi_comm_spawn_f
|
||||
#define mpi_comm_spawn_multiple_f pmpi_comm_spawn_multiple_f
|
||||
#define mpi_comm_split_f pmpi_comm_split_f
|
||||
#define mpi_comm_split_type_f pmpi_comm_split_type_f
|
||||
#define mpi_comm_test_inter_f pmpi_comm_test_inter_f
|
||||
#define mpi_dims_create_f pmpi_dims_create_f
|
||||
#define mpi_errhandler_create_f pmpi_errhandler_create_f
|
||||
|
||||
@ -124,6 +124,7 @@ PN(void, mpi_comm_size, MPI_COMM_SIZE, (MPI_Fint *comm, MPI_Fint *size, MPI_Fint
|
||||
PN(void, mpi_comm_spawn, MPI_COMM_SPAWN, (char *command, char *argv, MPI_Fint *maxprocs, MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr, int command_len, int argv_len));
|
||||
PN(void, mpi_comm_spawn_multiple, MPI_COMM_SPAWN_MULTIPLE, (MPI_Fint *count, char *array_of_commands, char *array_of_argv, MPI_Fint *array_of_maxprocs, MPI_Fint *array_of_info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr, int cmd_len, int argv_len));
|
||||
PN(void, mpi_comm_split, MPI_COMM_SPLIT, (MPI_Fint *comm, MPI_Fint *color, MPI_Fint *key, MPI_Fint *newcomm, MPI_Fint *ierr));
|
||||
PN(void, mpi_comm_split_type, MPI_COMM_SPLIT_TYPE, (MPI_Fint *comm, MPI_Fint *split_type, MPI_Fint *key, MPI_Fint *info, MPI_Fint *newcomm, MPI_Fint *ierr));
|
||||
PN(void, mpi_comm_test_inter, MPI_COMM_TEST_INTER, (MPI_Fint *comm, ompi_fortran_logical_t *flag, MPI_Fint *ierr));
|
||||
PN(void, mpi_dims_create, MPI_DIMS_CREATE, (MPI_Fint *nnodes, MPI_Fint *ndims, MPI_Fint *dims, MPI_Fint *ierr));
|
||||
PN(void, mpi_errhandler_create, MPI_ERRHANDLER_CREATE, (ompi_errhandler_fortran_handler_fn_t* function, MPI_Fint *errhandler, MPI_Fint *ierr));
|
||||
|
||||
Загрузка…
x
Ссылка в новой задаче
Block a user