void ompi_win_set_name_f(MPI_Fint *win, char *win_name, MPI_Fint *ierr,
int name_len)
{
int ret, c_ierr;
char *c_name;
MPI_Win c_win;
c_win = PMPI_Win_f2c(*win);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(win_name, name_len,
&c_name))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
"MPI_WIN_SET_NAME");
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
/* Call the C function */
c_ierr = PMPI_Win_set_name(c_win, c_name);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
/* Free the C name */
free(c_name);
}
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_win_flush_f(MPI_Fint *rank, MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Win_flush(OMPI_FINT_2_INT(*rank), c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_flush_local_all_f(MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Win_flush_local_all(c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_detach_f(MPI_Fint *win, char *base,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win;
c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Win_detach(c_win, base);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_post_f(MPI_Fint *group, MPI_Fint *assert,
MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = PMPI_Win_f2c(*win);
MPI_Group c_grp = PMPI_Group_f2c(*group);
c_ierr = PMPI_Win_post(c_grp,
OMPI_FINT_2_INT(*assert),
c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_get_group_f(MPI_Fint *win, MPI_Fint *group, MPI_Fint *ierr)
{
int c_ierr;
MPI_Group c_grp;
MPI_Win c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Win_get_group(c_win, &c_grp);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*group = PMPI_Group_c2f(c_grp);
}
}
void ompi_win_get_errhandler_f(MPI_Fint *win, MPI_Fint *errhandler,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Errhandler c_err;
MPI_Win c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Win_get_errhandler(c_win, &c_err);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*errhandler = PMPI_Errhandler_c2f(c_err);
}
}
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_win_get_attr_f(MPI_Fint *win, MPI_Fint *win_keyval,
MPI_Aint *attribute_val, ompi_fortran_logical_t *flag, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = PMPI_Win_f2c(*win);
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_fortran_mpi2(c_win->w_keyhash,
OMPI_FINT_2_INT(*win_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_shared_query_f(MPI_Fint *win, MPI_Fint *rank, MPI_Aint *size,
MPI_Fint *disp_unit, char *baseptr,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win;
OMPI_SINGLE_NAME_DECL(disp_unit);
c_win = PMPI_Win_f2c(*win);
c_ierr = PMPI_Win_shared_query(c_win, OMPI_FINT_2_INT(*rank), size,
OMPI_SINGLE_NAME_CONVERT(disp_unit), baseptr);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
OMPI_SINGLE_INT_2_FINT(disp_unit);
}
}
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_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);
}
MPI_Win MPI_Win_f2c(MPI_Fint win){
return PMPI_Win_f2c(win);
}
