void ompi_igatherv_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
char *recvbuf, MPI_Fint *recvcounts, MPI_Fint *displs,
MPI_Fint *recvtype, MPI_Fint *root, MPI_Fint *comm,
MPI_Fint *request, MPI_Fint *ierr)
{
MPI_Comm c_comm;
MPI_Datatype c_sendtype, c_recvtype;
MPI_Request c_request;
int size, c_ierr;
OMPI_ARRAY_NAME_DECL(recvcounts);
OMPI_ARRAY_NAME_DECL(displs);
c_comm = PMPI_Comm_f2c(*comm);
c_sendtype = PMPI_Type_f2c(*sendtype);
c_recvtype = PMPI_Type_f2c(*recvtype);
PMPI_Comm_size(c_comm, &size);
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
OMPI_ARRAY_FINT_2_INT(displs, size);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = PMPI_Igatherv(sendbuf, OMPI_FINT_2_INT(*sendcount),
c_sendtype, recvbuf,
OMPI_ARRAY_NAME_CONVERT(recvcounts),
OMPI_ARRAY_NAME_CONVERT(displs),
c_recvtype,
OMPI_FINT_2_INT(*root),
c_comm, &c_request);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request);
}
void ompi_ireduce_scatter_f(char *sendbuf, char *recvbuf,
MPI_Fint *recvcounts, MPI_Fint *datatype,
MPI_Fint *op, MPI_Fint *comm, MPI_Fint *request,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm;
MPI_Datatype c_type;
MPI_Request c_request;
MPI_Op c_op;
int size;
OMPI_ARRAY_NAME_DECL(recvcounts);
c_comm = PMPI_Comm_f2c(*comm);
c_type = PMPI_Type_f2c(*datatype);
c_op = PMPI_Op_f2c(*op);
PMPI_Comm_size(c_comm, &size);
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = PMPI_Ireduce_scatter(sendbuf, recvbuf,
OMPI_ARRAY_NAME_CONVERT(recvcounts),
c_type, c_op, c_comm, &c_request);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request);
}
void ompix_allgather_init_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
MPI_Fint *comm, MPI_Fint *info, MPI_Fint *request, MPI_Fint *ierr)
{
int ierr_c;
MPI_Comm c_comm;
MPI_Request c_req;
MPI_Datatype c_sendtype, c_recvtype;
MPI_Info c_info;
c_comm = PMPI_Comm_f2c(*comm);
c_sendtype = PMPI_Type_f2c(*sendtype);
c_recvtype = PMPI_Type_f2c(*recvtype);
c_info = PMPI_Info_f2c(*info);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
ierr_c = PMPIX_Allgather_init(sendbuf,
OMPI_FINT_2_INT(*sendcount),
c_sendtype,
recvbuf,
OMPI_FINT_2_INT(*recvcount),
c_recvtype, c_comm, c_info, &c_req);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);
if (MPI_SUCCESS == ierr_c) *request = PMPI_Request_c2f(c_req);
}
void ompi_ireduce_f(char *sendbuf, char *recvbuf, MPI_Fint *count,
MPI_Fint *datatype, MPI_Fint *op,
MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type;
MPI_Request c_request;
MPI_Op c_op;
MPI_Comm c_comm;
c_type = PMPI_Type_f2c(*datatype);
c_op = PMPI_Op_f2c(*op);
c_comm = PMPI_Comm_f2c(*comm);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = PMPI_Ireduce(sendbuf, recvbuf,
OMPI_FINT_2_INT(*count),
c_type, c_op,
OMPI_FINT_2_INT(*root),
c_comm, &c_request);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request);
}
void ompi_reduce_scatter_block_f(char *sendbuf, char *recvbuf,
MPI_Fint *recvcount, MPI_Fint *datatype,
MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm;
MPI_Datatype c_type;
MPI_Op c_op;
int size;
c_comm = PMPI_Comm_f2c(*comm);
c_type = PMPI_Type_f2c(*datatype);
c_op = PMPI_Op_f2c(*op);
PMPI_Comm_size(c_comm, &size);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = PMPI_Reduce_scatter_block(sendbuf, recvbuf,
OMPI_FINT_2_INT(*recvcount),
c_type, c_op, c_comm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_sendrecv_replace_f(char *buf, MPI_Fint *count, MPI_Fint *datatype,
MPI_Fint *dest, MPI_Fint *sendtag,
MPI_Fint *source, MPI_Fint *recvtag,
MPI_Fint *comm, MPI_Fint *status, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = PMPI_Type_f2c(*datatype);
MPI_Comm c_comm;
MPI_Status c_status;
c_comm = PMPI_Comm_f2c (*comm);
c_ierr = PMPI_Sendrecv_replace(OMPI_F2C_BOTTOM(buf),
OMPI_FINT_2_INT(*count),
c_type,
OMPI_FINT_2_INT(*dest),
OMPI_FINT_2_INT(*sendtag),
OMPI_FINT_2_INT(*source),
OMPI_FINT_2_INT(*recvtag),
c_comm, &c_status);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr &&
!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
PMPI_Status_c2f(&c_status, status);
}
}
void ompi_cart_get_f(MPI_Fint *comm, MPI_Fint *maxdims, MPI_Fint *dims,
ompi_fortran_logical_t *periods, MPI_Fint *coords, MPI_Fint *ierr)
{
MPI_Comm c_comm;
int size, c_ierr;
OMPI_ARRAY_NAME_DECL(dims);
OMPI_ARRAY_NAME_DECL(coords);
OMPI_LOGICAL_ARRAY_NAME_DECL(periods);
c_comm = PMPI_Comm_f2c(*comm);
size = OMPI_FINT_2_INT(*maxdims);
OMPI_ARRAY_FINT_2_INT_ALLOC(dims, size);
OMPI_ARRAY_FINT_2_INT_ALLOC(coords, size);
OMPI_ARRAY_LOGICAL_2_INT_ALLOC(periods, size);
c_ierr = PMPI_Cart_get(c_comm,
size,
OMPI_ARRAY_NAME_CONVERT(dims),
OMPI_LOGICAL_ARRAY_NAME_CONVERT(periods),
OMPI_ARRAY_NAME_CONVERT(coords));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ARRAY_INT_2_FINT(dims, size);
OMPI_ARRAY_INT_2_LOGICAL(periods, size);
OMPI_ARRAY_INT_2_FINT(coords, size);
}
void ompi_comm_spawn_f(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 cmd_len, int string_len)
{
MPI_Comm c_comm, c_new_comm;
MPI_Info c_info;
int size, c_ierr;
int *c_errs;
char **c_argv;
char *c_command;
OMPI_ARRAY_NAME_DECL(array_of_errcodes);
c_comm = PMPI_Comm_f2c(*comm);
c_info = PMPI_Info_f2c(*info);
PMPI_Comm_size(c_comm, &size);
ompi_fortran_string_f2c(command, cmd_len, &c_command);
/* It's allowed to ignore the errcodes */
if (OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_of_errcodes)) {
c_errs = MPI_ERRCODES_IGNORE;
} else {
OMPI_ARRAY_FINT_2_INT_ALLOC(array_of_errcodes, size);
c_errs = OMPI_ARRAY_NAME_CONVERT(array_of_errcodes);
}
/* It's allowed to have no argv */
if (OMPI_IS_FORTRAN_ARGV_NULL(argv)) {
c_argv = MPI_ARGV_NULL;
} else {
ompi_fortran_argv_blank_f2c(argv, string_len, string_len, &c_argv);
}
c_ierr = PMPI_Comm_spawn(c_command, c_argv,
OMPI_FINT_2_INT(*maxprocs),
c_info,
OMPI_FINT_2_INT(*root),
c_comm, &c_new_comm, c_errs);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*intercomm = PMPI_Comm_c2f(c_new_comm);
}
free(c_command);
if (MPI_ARGV_NULL != c_argv && NULL != c_argv) {
opal_argv_free(c_argv);
}
if (!OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_of_errcodes)) {
OMPI_ARRAY_INT_2_FINT(array_of_errcodes, size);
} else {
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_errcodes);
}
}
/**
* Measurement wrapper for MPI_Comm_f2c
* @note Auto-generated by wrapgen from template: std.w
* @note C interface
* @note Introduced with MPI 2.0
* @ingroup cg_misc
*/
MPI_Comm MPI_Comm_f2c(MPI_Fint comm)
{
MPI_Comm return_val;
if (IS_EVENT_GEN_ON_FOR(CG_MISC))
{
EVENT_GEN_OFF();
esd_enter(epk_mpi_regid[EPK__MPI_COMM_F2C]);
return_val = PMPI_Comm_f2c(comm);
esd_exit(epk_mpi_regid[EPK__MPI_COMM_F2C]);
EVENT_GEN_ON();
}
else
{
return_val = PMPI_Comm_f2c(comm);
}
return return_val;
}
void ompi_alltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
MPI_Fint *sdispls, MPI_Fint *sendtypes,
char *recvbuf, MPI_Fint *recvcounts,
MPI_Fint *rdispls, MPI_Fint *recvtypes,
MPI_Fint *comm, MPI_Fint *ierr)
{
MPI_Comm c_comm;
MPI_Datatype *c_sendtypes, *c_recvtypes;
int size, c_ierr;
OMPI_ARRAY_NAME_DECL(sendcounts);
OMPI_ARRAY_NAME_DECL(sdispls);
OMPI_ARRAY_NAME_DECL(recvcounts);
OMPI_ARRAY_NAME_DECL(rdispls);
c_comm = PMPI_Comm_f2c(*comm);
PMPI_Comm_size(c_comm, &size);
c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
OMPI_ARRAY_FINT_2_INT(sendcounts, size);
OMPI_ARRAY_FINT_2_INT(sdispls, size);
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
OMPI_ARRAY_FINT_2_INT(rdispls, size);
while (size > 0) {
c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]);
c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]);
--size;
}
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = PMPI_Alltoallw(sendbuf,
OMPI_ARRAY_NAME_CONVERT(sendcounts),
OMPI_ARRAY_NAME_CONVERT(sdispls),
c_sendtypes,
recvbuf,
OMPI_ARRAY_NAME_CONVERT(recvcounts),
OMPI_ARRAY_NAME_CONVERT(rdispls),
c_recvtypes, c_comm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts);
OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls);
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
free(c_sendtypes);
free(c_recvtypes);
}
void ompi_comm_size_f(MPI_Fint *comm, MPI_Fint *size, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm = PMPI_Comm_f2c( *comm );
OMPI_SINGLE_NAME_DECL(size);
c_ierr = PMPI_Comm_size( c_comm, OMPI_SINGLE_NAME_CONVERT(size) );
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_FINT(size);
}
}
void ompi_comm_group_f(MPI_Fint *comm, MPI_Fint *group, MPI_Fint *ierr)
{
int c_ierr;
MPI_Group c_group;
MPI_Comm c_comm = PMPI_Comm_f2c( *comm );
c_ierr = PMPI_Comm_group( c_comm, &c_group);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*group = PMPI_Group_c2f (c_group);
}
}
void ompi_topo_test_f(MPI_Fint *comm, MPI_Fint *topo_type, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm;
OMPI_SINGLE_NAME_DECL(topo_type);
c_comm = PMPI_Comm_f2c(*comm);
c_ierr = PMPI_Topo_test(c_comm, OMPI_SINGLE_NAME_CONVERT(topo_type));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_FINT(topo_type);
}
}
void ompi_dist_graph_neighbors_f(MPI_Fint* comm, MPI_Fint* maxindegree,
MPI_Fint* sources, MPI_Fint* sourceweights,
MPI_Fint* maxoutdegree, MPI_Fint* destinations,
MPI_Fint* destweights,
MPI_Fint *ierr)
{
MPI_Comm c_comm;
OMPI_ARRAY_NAME_DECL(sources);
OMPI_ARRAY_NAME_DECL(sourceweights);
OMPI_ARRAY_NAME_DECL(destinations);
OMPI_ARRAY_NAME_DECL(destweights);
c_comm = PMPI_Comm_f2c(*comm);
OMPI_ARRAY_FINT_2_INT_ALLOC(sources, *maxindegree);
if( !OMPI_IS_FORTRAN_UNWEIGHTED(sourceweights) ) {
OMPI_ARRAY_FINT_2_INT_ALLOC(sourceweights, *maxindegree);
}
OMPI_ARRAY_FINT_2_INT_ALLOC(destinations, *maxoutdegree);
if( !OMPI_IS_FORTRAN_UNWEIGHTED(destweights) ) {
OMPI_ARRAY_FINT_2_INT_ALLOC(destweights, *maxoutdegree);
}
*ierr = OMPI_INT_2_FINT(PMPI_Dist_graph_neighbors(c_comm, OMPI_FINT_2_INT(*maxindegree),
OMPI_ARRAY_NAME_CONVERT(sources),
OMPI_IS_FORTRAN_UNWEIGHTED(sourceweights) ? MPI_UNWEIGHTED : OMPI_ARRAY_NAME_CONVERT(sourceweights),
OMPI_FINT_2_INT(*maxoutdegree), OMPI_ARRAY_NAME_CONVERT(destinations),
OMPI_IS_FORTRAN_UNWEIGHTED(destweights) ? MPI_UNWEIGHTED : OMPI_ARRAY_NAME_CONVERT(destweights)));
if (OMPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_ARRAY_INT_2_FINT(sources, *maxindegree);
if( !OMPI_IS_FORTRAN_UNWEIGHTED(sourceweights) ) {
OMPI_ARRAY_INT_2_FINT(sourceweights, *maxindegree);
}
OMPI_ARRAY_INT_2_FINT(destinations, *maxoutdegree);
if( !OMPI_IS_FORTRAN_UNWEIGHTED(destweights) ) {
OMPI_ARRAY_INT_2_FINT(destweights, *maxoutdegree);
}
} else {
OMPI_ARRAY_FINT_2_INT_CLEANUP(sources);
if( !OMPI_IS_FORTRAN_UNWEIGHTED(sourceweights) ) {
OMPI_ARRAY_FINT_2_INT_CLEANUP(sourceweights);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(destinations);
if( !OMPI_IS_FORTRAN_UNWEIGHTED(destweights) ) {
OMPI_ARRAY_FINT_2_INT_CLEANUP(destweights);
}
}
}
void ompi_comm_set_attr_f(MPI_Fint *comm, MPI_Fint *comm_keyval,
MPI_Aint *attribute_val, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
/* This stuff is very confusing. Be sure to see the comment at
the top of src/attributes/attributes.c. */
c_ierr = ompi_attr_set_aint(COMM_ATTR,
c_comm,
&c_comm->c_keyhash,
OMPI_FINT_2_INT(*comm_keyval),
*attribute_val,
false);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_comm_split_f(MPI_Fint *comm, MPI_Fint *color, MPI_Fint *key,
MPI_Fint *newcomm, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_newcomm;
MPI_Comm c_comm = PMPI_Comm_f2c ( *comm );
c_ierr = PMPI_Comm_split(c_comm,
OMPI_FINT_2_INT(*color),
OMPI_FINT_2_INT(*key),
&c_newcomm );
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newcomm = PMPI_Comm_c2f (c_newcomm);
}
}
void ompi_attr_get_f(MPI_Fint *comm, MPI_Fint *keyval,
MPI_Fint *attribute_val, ompi_fortran_logical_t *flag, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
OMPI_LOGICAL_NAME_DECL(flag);
/* This stuff is very confusing. Be sure to see the comment at
the top of src/attributes/attributes.c. */
c_ierr = ompi_attr_get_fint(c_comm->c_keyhash,
OMPI_FINT_2_INT(*keyval),
attribute_val,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
void ompi_win_allocate_f(MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm, char *baseptr,
MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Info c_info;
MPI_Comm c_comm;
MPI_Win c_win;
c_info = PMPI_Info_f2c(*info);
c_comm = PMPI_Comm_f2c(*comm);
c_ierr = PMPI_Win_allocate(*size, OMPI_FINT_2_INT(*disp_unit),
c_info, c_comm,
baseptr, &c_win);
*win = PMPI_Win_c2f(c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_issend_f(char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = PMPI_Type_f2c(*datatype);
MPI_Request c_req;
MPI_Comm c_comm;
c_comm = PMPI_Comm_f2c (*comm);
c_ierr = PMPI_Issend(OMPI_F2C_BOTTOM(buf), OMPI_FINT_2_INT(*count),
c_type, OMPI_FINT_2_INT(*dest),
OMPI_FINT_2_INT(*tag),
c_comm, &c_req);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*request = PMPI_Request_c2f(c_req);
}
}
void ompi_neighbor_alltoallv_f(char *sendbuf, MPI_Fint *sendcounts, MPI_Fint *sdispls,
MPI_Fint *sendtype, char *recvbuf, MPI_Fint *recvcounts,
MPI_Fint *rdispls, MPI_Fint *recvtype,
MPI_Fint *comm, MPI_Fint *ierr)
{
MPI_Comm c_comm;
MPI_Datatype c_sendtype, c_recvtype;
int size, c_ierr;
OMPI_ARRAY_NAME_DECL(sendcounts);
OMPI_ARRAY_NAME_DECL(sdispls);
OMPI_ARRAY_NAME_DECL(recvcounts);
OMPI_ARRAY_NAME_DECL(rdispls);
c_comm = PMPI_Comm_f2c(*comm);
c_sendtype = PMPI_Type_f2c(*sendtype);
c_recvtype = PMPI_Type_f2c(*recvtype);
PMPI_Comm_size(c_comm, &size);
OMPI_ARRAY_FINT_2_INT(sendcounts, size);
OMPI_ARRAY_FINT_2_INT(sdispls, size);
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
OMPI_ARRAY_FINT_2_INT(rdispls, size);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = PMPI_Neighbor_alltoallv(sendbuf,
OMPI_ARRAY_NAME_CONVERT(sendcounts),
OMPI_ARRAY_NAME_CONVERT(sdispls),
c_sendtype,
recvbuf,
OMPI_ARRAY_NAME_CONVERT(recvcounts),
OMPI_ARRAY_NAME_CONVERT(rdispls),
c_recvtype, c_comm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts);
OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls);
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
}
void ompi_dist_graph_neighbors_count_f(MPI_Fint *comm, MPI_Fint *inneighbors,
MPI_Fint *outneighbors, ompi_fortran_logical_t *weighted,
MPI_Fint *ierr)
{
MPI_Comm c_comm;
OMPI_SINGLE_NAME_DECL(inneighbors);
OMPI_SINGLE_NAME_DECL(outneighbors);
OMPI_LOGICAL_NAME_DECL(weighted);
c_comm = PMPI_Comm_f2c(*comm);
*ierr = OMPI_INT_2_FINT(PMPI_Dist_graph_neighbors_count(c_comm,
OMPI_SINGLE_NAME_CONVERT(inneighbors),
OMPI_SINGLE_NAME_CONVERT(outneighbors),
OMPI_LOGICAL_SINGLE_NAME_CONVERT(weighted)));
OMPI_SINGLE_INT_2_LOGICAL(weighted);
if (OMPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
OMPI_SINGLE_INT_2_FINT(inneighbors);
OMPI_SINGLE_INT_2_FINT(outneighbors);
}
}
void ompi_win_create_f(char *base, MPI_Aint *size, MPI_Fint *disp_unit,
MPI_Fint *info, MPI_Fint *comm, MPI_Fint *win,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win;
MPI_Info c_info;
MPI_Comm c_comm;
c_comm = PMPI_Comm_f2c(*comm);
c_info = PMPI_Info_f2c(*info);
c_ierr = PMPI_Win_create(base, *size,
OMPI_FINT_2_INT(*disp_unit),
c_info, c_comm, &c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*win = PMPI_Win_c2f(c_win);
}
}
void ompi_allreduce_f(char *sendbuf, char *recvbuf, MPI_Fint *count,
MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm,
MPI_Fint *ierr)
{
int ierr_c;
MPI_Comm c_comm;
MPI_Datatype c_type;
MPI_Op c_op;
c_comm = PMPI_Comm_f2c(*comm);
c_type = PMPI_Type_f2c(*datatype);
c_op = PMPI_Op_f2c(*op);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
ierr_c = PMPI_Allreduce(sendbuf, recvbuf,
OMPI_FINT_2_INT(*count),
c_type, c_op, c_comm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);
}
void ompi_iprobe_f(MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm,
ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm;
OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2)
OMPI_LOGICAL_NAME_DECL(flag);
c_comm = PMPI_Comm_f2c (*comm);
OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status)
c_ierr = PMPI_Iprobe(OMPI_FINT_2_INT(*source),
OMPI_FINT_2_INT(*tag),
c_comm, OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
c_status);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_LOGICAL(flag);
OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr)
}
void ompi_unpack_f(char *inbuf, MPI_Fint *insize, MPI_Fint *position,
char *outbuf, MPI_Fint *outcount, MPI_Fint *datatype,
MPI_Fint *comm, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm;
MPI_Datatype c_type;
OMPI_SINGLE_NAME_DECL(position);
c_comm = PMPI_Comm_f2c(*comm);
c_type = PMPI_Type_f2c(*datatype);
OMPI_SINGLE_FINT_2_INT(position);
c_ierr = PMPI_Unpack(inbuf, OMPI_FINT_2_INT(*insize),
OMPI_SINGLE_NAME_CONVERT(position),
OMPI_F2C_BOTTOM(outbuf), OMPI_FINT_2_INT(*outcount),
c_type, c_comm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_FINT(position);
}
}
void ompi_comm_accept_f(char *port_name, MPI_Fint *info, MPI_Fint *root,
MPI_Fint *comm, MPI_Fint *newcomm, MPI_Fint *ierr,
int port_name_len)
{
int c_ierr;
MPI_Comm c_comm, c_new_comm;
MPI_Info c_info;
char *c_port_name;
c_comm = PMPI_Comm_f2c(*comm);
c_info = PMPI_Info_f2c(*info);
ompi_fortran_string_f2c(port_name, port_name_len, &c_port_name);
c_ierr = PMPI_Comm_accept(c_port_name, c_info,
OMPI_FINT_2_INT(*root),
c_comm, &c_new_comm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newcomm = PMPI_Comm_c2f(c_new_comm);
}
free ( c_port_name );
}
MPI_Comm MPI_Comm_f2c(MPI_Fint comm){
return PMPI_Comm_f2c(comm);
}
void ompi_comm_spawn_multiple_f(MPI_Fint *count, char *array_commands,
char *array_argv,
MPI_Fint *array_maxprocs,
MPI_Fint *array_info, MPI_Fint *root,
MPI_Fint *comm, MPI_Fint *intercomm,
MPI_Fint *array_errcds, MPI_Fint *ierr,
int cmd_string_len, int argv_string_len)
{
MPI_Comm c_comm, c_new_comm;
MPI_Info *c_info;
int size, array_size, i, c_ierr;
int *c_errs;
char **c_array_commands;
char ***c_array_argv;
OMPI_ARRAY_NAME_DECL(array_maxprocs);
OMPI_ARRAY_NAME_DECL(array_errcds);
c_comm = PMPI_Comm_f2c(*comm);
PMPI_Comm_size(c_comm, &size);
array_size = OMPI_FINT_2_INT(*count);
/* It's allowed to ignore the errcodes */
if (OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_errcds)) {
c_errs = MPI_ERRCODES_IGNORE;
} else {
OMPI_ARRAY_FINT_2_INT_ALLOC(array_errcds, size);
c_errs = OMPI_ARRAY_NAME_CONVERT(array_errcds);
}
/* It's allowed to have no argv */
if (OMPI_IS_FORTRAN_ARGVS_NULL(array_argv)) {
c_array_argv = MPI_ARGVS_NULL;
} else {
ompi_fortran_multiple_argvs_f2c(OMPI_FINT_2_INT(*count), array_argv,
argv_string_len, &c_array_argv);
}
OMPI_ARRAY_FINT_2_INT(array_maxprocs, array_size);
ompi_fortran_argv_f2c(array_commands, cmd_string_len,
cmd_string_len, &c_array_commands);
c_info = (MPI_Info *) malloc (array_size * sizeof(MPI_Info));
for (i = 0; i < array_size; ++i) {
c_info[i] = PMPI_Info_f2c(array_info[i]);
}
c_ierr = PMPI_Comm_spawn_multiple(OMPI_FINT_2_INT(*count),
c_array_commands,
c_array_argv,
OMPI_ARRAY_NAME_CONVERT(array_maxprocs),
c_info,
OMPI_FINT_2_INT(*root),
c_comm, &c_new_comm,
c_errs);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*intercomm = PMPI_Comm_c2f(c_new_comm);
}
if (!OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_errcds)) {
OMPI_ARRAY_INT_2_FINT(array_errcds, size);
} else {
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_errcds);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_maxprocs);
opal_argv_free(c_array_commands);
if (MPI_ARGVS_NULL != c_array_argv && NULL != c_array_argv) {
for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
opal_argv_free(c_array_argv[i]);
}
}
free(c_array_argv);
}