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_file_set_view_f(MPI_Fint *fh, MPI_Offset *disp,
MPI_Fint *etype, MPI_Fint *filetype,
char *datarep, MPI_Fint *info, MPI_Fint *ierr,
int datarep_len)
{
MPI_File c_fh = PMPI_File_f2c(*fh);
MPI_Datatype c_etype = PMPI_Type_f2c(*etype);
MPI_Datatype c_filetype = PMPI_Type_f2c(*filetype);
MPI_Info c_info = PMPI_Info_f2c(*info);
char *c_datarep;
int c_ierr, ret;
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
&c_datarep))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(c_fh, ret, "MPI_FILE_SET_VIEW");
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
c_ierr = PMPI_File_set_view(c_fh, (MPI_Offset) *disp,
c_etype, c_filetype,
c_datarep, c_info);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
free(c_datarep);
}
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_rput_f(char *origin_addr, MPI_Fint *origin_count,
MPI_Fint *origin_datatype, MPI_Fint *target_rank,
MPI_Aint *target_disp, MPI_Fint *target_count,
MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_origin_datatype = PMPI_Type_f2c(*origin_datatype);
MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype);
MPI_Win c_win = PMPI_Win_f2c(*win);
MPI_Request c_req;
c_ierr = PMPI_Rput(OMPI_F2C_BOTTOM(origin_addr),
OMPI_FINT_2_INT(*origin_count),
c_origin_datatype,
OMPI_FINT_2_INT(*target_rank),
*target_disp,
OMPI_FINT_2_INT(*target_count),
c_target_datatype, c_win, &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_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_type_create_subarray_f(MPI_Fint *ndims, MPI_Fint *size_array,
MPI_Fint *subsize_array,
MPI_Fint *start_array, MPI_Fint *order,
MPI_Fint *oldtype, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old;
MPI_Datatype c_new;
OMPI_ARRAY_NAME_DECL(size_array);
OMPI_ARRAY_NAME_DECL(subsize_array);
OMPI_ARRAY_NAME_DECL(start_array);
c_old = PMPI_Type_f2c(*oldtype);
OMPI_ARRAY_FINT_2_INT(size_array, *ndims);
OMPI_ARRAY_FINT_2_INT(subsize_array, *ndims);
OMPI_ARRAY_FINT_2_INT(start_array, *ndims);
c_ierr = PMPI_Type_create_subarray(OMPI_FINT_2_INT(*ndims),
OMPI_ARRAY_NAME_CONVERT(size_array),
OMPI_ARRAY_NAME_CONVERT(subsize_array),
OMPI_ARRAY_NAME_CONVERT(start_array),
*order, c_old, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(size_array);
OMPI_ARRAY_FINT_2_INT_CLEANUP(subsize_array);
OMPI_ARRAY_FINT_2_INT_CLEANUP(start_array);
}
void ompi_type_create_hindexed_f(MPI_Fint *count,
MPI_Fint *array_of_blocklengths,
MPI_Aint *array_of_displacements,
MPI_Fint *oldtype, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old = PMPI_Type_f2c(*oldtype);
MPI_Datatype c_new;
OMPI_ARRAY_NAME_DECL(array_of_blocklengths);
OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count);
c_ierr = PMPI_Type_create_hindexed(OMPI_FINT_2_INT(*count),
OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths),
array_of_displacements, c_old,
&c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths);
}
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_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_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_status_set_elements_f(MPI_Fint *status, MPI_Fint *datatype,
MPI_Fint *count, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = PMPI_Type_f2c(*datatype);
MPI_Status c_status;
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
c_ierr = MPI_SUCCESS;
} else {
PMPI_Status_f2c( status, &c_status );
c_ierr = PMPI_Status_set_elements(&c_status, c_type,
OMPI_FINT_2_INT(*count));
/* If datatype is really being set, then that needs to be
converted.... */
if (MPI_SUCCESS == c_ierr) {
PMPI_Status_c2f(&c_status, status);
}
}
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
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 ompi_put_f(char *origin_addr, MPI_Fint *origin_count,
MPI_Fint *origin_datatype, MPI_Fint *target_rank,
MPI_Aint *target_disp, MPI_Fint *target_count,
MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_origin_datatype = PMPI_Type_f2c(*origin_datatype);
MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype);
MPI_Win c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Put(OMPI_F2C_BOTTOM(origin_addr),
OMPI_FINT_2_INT(*origin_count),
c_origin_datatype,
OMPI_FINT_2_INT(*target_rank),
*target_disp,
OMPI_FINT_2_INT(*target_count),
c_target_datatype, c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
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_type_lb_f(MPI_Fint *type, MPI_Fint *lb, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = PMPI_Type_f2c(*type);
MPI_Aint c_lb;
c_ierr = PMPI_Type_lb(c_type, &c_lb);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*lb = OMPI_INT_2_FINT(c_lb);
}
}
void ompi_accumulate_f(char *origin_addr, MPI_Fint *origin_count,
MPI_Fint *origin_datatype, MPI_Fint *target_rank,
MPI_Aint *target_disp, MPI_Fint *target_count,
MPI_Fint *target_datatype, MPI_Fint *op, MPI_Fint *win,
MPI_Fint *ierr)
{
int ierr_c;
MPI_Datatype c_origin_datatype = PMPI_Type_f2c(*origin_datatype);
MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype);
MPI_Win c_win = PMPI_Win_f2c(*win);
MPI_Op c_op = PMPI_Op_f2c(*op);
ierr_c = PMPI_Accumulate(OMPI_F2C_BOTTOM(origin_addr),
OMPI_FINT_2_INT(*origin_count),
c_origin_datatype,
OMPI_FINT_2_INT(*target_rank),
*target_disp,
OMPI_FINT_2_INT(*target_count),
c_target_datatype, c_op, c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);
}
void ompi_type_create_resized_f(MPI_Fint *oldtype, MPI_Aint *lb,
MPI_Aint *extent, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old = PMPI_Type_f2c(*oldtype);
MPI_Datatype c_new;
c_ierr = PMPI_Type_create_resized(c_old, *lb, *extent, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
}
void ompi_file_iwrite_all_f(MPI_Fint *fh, char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *request, MPI_Fint *ierr)
{
int c_ierr;
MPI_File c_fh = PMPI_File_f2c(*fh);
MPI_Datatype c_type = PMPI_Type_f2c(*datatype);
MPI_Request c_request;
c_ierr = PMPI_File_iwrite_all(c_fh, OMPI_F2C_BOTTOM(buf),
OMPI_FINT_2_INT(*count),
c_type, &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_compare_and_swap_f(char *origin_addr, char *compare_addr, char *result_addr,
MPI_Fint *datatype, MPI_Fint *target_rank, MPI_Aint *target_disp,
MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_datatype = PMPI_Type_f2c(*datatype);
MPI_Win c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Compare_and_swap(OMPI_F2C_BOTTOM(origin_addr),
OMPI_F2C_BOTTOM(compare_addr),
OMPI_F2C_BOTTOM(result_addr),
c_datatype,
OMPI_FINT_2_INT(*target_rank),
*target_disp, c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_file_write_f(MPI_Fint *fh, char *buf, MPI_Fint *count,
MPI_Fint *datatype, MPI_Fint *status, MPI_Fint *ierr)
{
int c_ierr;
MPI_File c_fh = PMPI_File_f2c(*fh);
MPI_Datatype c_type = PMPI_Type_f2c(*datatype);
OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2)
OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status)
c_ierr = PMPI_File_write(c_fh, OMPI_F2C_BOTTOM(buf),
OMPI_FINT_2_INT(*count),
c_type, c_status);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr)
}
void ompi_type_create_hindexed_block_f(MPI_Fint *count, MPI_Fint *blocklength,
MPI_Aint *array_of_displacements,
MPI_Fint *oldtype, MPI_Fint *newtype,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old = PMPI_Type_f2c(*oldtype);
MPI_Datatype c_new;
c_ierr = PMPI_Type_create_hindexed_block(OMPI_FINT_2_INT(*count),
OMPI_FINT_2_INT(*blocklength),
array_of_displacements,
c_old, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
}
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_type_struct_f(MPI_Fint *count, MPI_Fint *array_of_blocklengths,
MPI_Fint *array_of_displacements,
MPI_Fint *array_of_types, MPI_Fint *newtype,
MPI_Fint *ierr)
{
MPI_Aint *c_disp_array;
MPI_Datatype *c_type_old_array;
MPI_Datatype c_new;
int i, c_ierr;
OMPI_ARRAY_NAME_DECL(array_of_blocklengths);
c_type_old_array = (MPI_Datatype *) malloc(*count * (sizeof(MPI_Datatype) +
sizeof(MPI_Aint)));
if (NULL == c_type_old_array) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_NO_MEM,
FUNC_NAME);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
c_disp_array = (MPI_Aint*) c_type_old_array + *count;
for (i = 0; i < *count; i++) {
c_disp_array[i] = (MPI_Aint) array_of_displacements[i];
c_type_old_array[i] = PMPI_Type_f2c(array_of_types[i]);
}
OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count);
c_ierr = PMPI_Type_struct(OMPI_FINT_2_INT(*count),
OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths),
c_disp_array,
c_type_old_array, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths);
free(c_type_old_array);
if (MPI_SUCCESS == c_ierr) {
*newtype = PMPI_Type_c2f(c_new);
}
}
void ompi_mrecv_f(char *buf, MPI_Fint *count, MPI_Fint *datatype,
MPI_Fint *message, MPI_Fint *status, MPI_Fint *ierr)
{
int c_ierr;
OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2)
MPI_Message c_message = PMPI_Message_f2c(*message);
MPI_Datatype c_type = PMPI_Type_f2c(*datatype);
OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status)
/* Call the C function */
c_ierr = OMPI_INT_2_FINT(PMPI_Mrecv(OMPI_F2C_BOTTOM(buf), OMPI_FINT_2_INT(*count),
c_type, &c_message,
c_status));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr)
/* message is an INOUT, and may be updated by the recv */
*message = PMPI_Message_c2f(c_message);
}
}
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_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);
}
}
MPI_Datatype MPI_Type_f2c(MPI_Fint datatype){
return PMPI_Type_f2c(datatype);
}
