void cmpif2readwin_( MPI_Fint *fwin, MPI_Fint *fkey, MPI_Aint *expected,
MPI_Fint *errs, const char *msg, int msglen )
{
void *attrval;
int flag, result;
MPI_Win win = MPI_Win_f2c( *fwin );
char lmsg[MAX_ATTRTEST_MSG];
if (msglen > sizeof(lmsg)- 1) {
fprintf( stderr, "Message too long for buffer (%d)\n", msglen );
MPI_Abort( MPI_COMM_WORLD, 1 );
}
MPI_Win_get_attr( win, *fkey, &attrval, &flag );
if (!flag) {
*errs = *errs + 1;
strncpy( lmsg, msg, msglen );
lmsg[msglen] = 0;
printf( " Error: flag false for Win_get_attr (set in F2): %s\n", lmsg );
return;
}
ccompareaint2void_( expected, attrval, &result );
if (!result) {
*errs = *errs + 1;
strncpy( lmsg, msg, msglen );
lmsg[msglen] = 0;
printf( " Error: (set in F2/Win) expected %ld but saw %ld: %s\n",
(long)*expected, (long)*(MPI_Aint*)attrval, lmsg );
return;
}
return;
}
void mpi_win_set_name_f(MPI_Fint *win, char *win_name, MPI_Fint *ierr,
int name_len)
{
int ret, c_err;
char *c_name;
MPI_Win c_win;
c_win = MPI_Win_f2c(*win);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(win_name, name_len,
&c_name))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
"MPI_WIN_SET_NAME");
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
/* Call the C function */
*ierr = OMPI_INT_2_FINT(MPI_Win_set_name(c_win, c_name));
/* Free the C name */
free(c_name);
}
void csetmpiwin_( MPI_Fint *fwin, MPI_Fint *fkey, MPI_Aint *val,
MPI_Fint *errs )
{
MPI_Win win = MPI_Win_f2c( *fwin );
MPI_Win_set_attr( win, *fkey, (void *)*val );
}
void ompi_win_flush_local_f(MPI_Fint *rank, MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_flush_local(OMPI_FINT_2_INT(*rank), c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_fence_f(MPI_Fint *assert, MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_fence(OMPI_FINT_2_INT(*assert), c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_wait_f(MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_wait(c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_delete_attr_f(MPI_Fint *win, MPI_Fint *win_keyval, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_delete_attr(c_win, OMPI_FINT_2_INT(*win_keyval));
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void mpi_win_set_errhandler_f(MPI_Fint *win, MPI_Fint *errhandler,
MPI_Fint *ierr)
{
MPI_Win c_win = MPI_Win_f2c(*win);
MPI_Errhandler c_err = MPI_Errhandler_f2c(*errhandler);
*ierr = OMPI_INT_2_FINT(MPI_Win_set_errhandler(c_win, c_err));
}
void ompi_win_set_errhandler_f(MPI_Fint *win, MPI_Fint *errhandler,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
MPI_Errhandler c_err = MPI_Errhandler_f2c(*errhandler);
c_ierr = MPI_Win_set_errhandler(c_win, c_err);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void mpi_win_post_f(MPI_Fint *group, MPI_Fint *assert,
MPI_Fint *win, MPI_Fint *ierr)
{
MPI_Win c_win = MPI_Win_f2c(*win);
MPI_Group c_grp = MPI_Group_f2c(*group);
*ierr = OMPI_INT_2_FINT(MPI_Win_post(c_grp,
OMPI_FINT_2_INT(*assert),
c_win));
}
void ompi_win_get_info_f(MPI_Fint *win, MPI_Fint *info, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win;
MPI_Info c_info;
c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_get_info(c_win, &c_info);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
*info = MPI_Info_c2f(c_info);
}
void ompi_win_lock_f(MPI_Fint *lock_type, MPI_Fint *rank,
MPI_Fint *assert, MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_lock(OMPI_FINT_2_INT(*lock_type),
OMPI_FINT_2_INT(*rank),
OMPI_FINT_2_INT(*assert),
c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_win_free_f(MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_free(&c_win);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*win = MPI_Win_c2f(c_win);
}
}
void ompi_win_post_f(MPI_Fint *group, MPI_Fint *assert,
MPI_Fint *win, MPI_Fint *ierr)
{
int c_ierr;
MPI_Win c_win = MPI_Win_f2c(*win);
MPI_Group c_grp = MPI_Group_f2c(*group);
c_ierr = MPI_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_errhandler_f(MPI_Fint *win, MPI_Fint *errhandler,
MPI_Fint *ierr)
{
int c_ierr;
MPI_Errhandler c_err;
MPI_Win c_win = MPI_Win_f2c(*win);
c_ierr = MPI_Win_get_errhandler(c_win, &c_err);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*errhandler = MPI_Errhandler_c2f(c_err);
}
}
void mpi_win_get_attr_f(MPI_Fint *win, MPI_Fint *win_keyval,
MPI_Aint *attribute_val, MPI_Flogical *flag, MPI_Fint *ierr)
{
int c_err;
MPI_Win c_win = MPI_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_err = ompi_attr_get_fortran_mpi2(c_win->w_keyhash,
OMPI_FINT_2_INT(*win_keyval),
attribute_val,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
*ierr = OMPI_INT_2_FINT(c_err);
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
void mpi_win_set_attr_f(MPI_Fint *win, MPI_Fint *win_keyval,
MPI_Aint *attribute_val, MPI_Fint *ierr)
{
int c_err;
MPI_Win c_win = MPI_Win_f2c(*win);
/* This stuff is very confusing. Be sure to see the comment at
the top of src/attributes/attributes.c. */
c_err = ompi_attr_set_fortran_mpi2(WIN_ATTR,
c_win,
&c_win->w_keyhash,
OMPI_FINT_2_INT(*win_keyval),
*attribute_val,
false);
*ierr = OMPI_INT_2_FINT(c_err);
}
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 = MPI_Type_f2c(*origin_datatype);
MPI_Datatype c_target_datatype = MPI_Type_f2c(*target_datatype);
MPI_Win c_win = MPI_Win_f2c(*win);
MPI_Op c_op = MPI_Op_f2c(*op);
ierr_c = MPI_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 mpi_win_fence_f(MPI_Fint *assert, MPI_Fint *win, MPI_Fint *ierr)
{
MPI_Win c_win = MPI_Win_f2c(*win);
*ierr = OMPI_INT_2_FINT(MPI_Win_fence(OMPI_FINT_2_INT(*assert), c_win));
}
void mpi_win_wait_f(MPI_Fint *win, MPI_Fint *ierr)
{
MPI_Win c_win = MPI_Win_f2c(*win);
*ierr = OMPI_INT_2_FINT(MPI_Win_wait(c_win));
}
EXPORT_MPI_API void FORTRAN_API mpi_win_fence_ (MPI_Fint *assert, MPI_Fint *win, MPI_Fint *__ierr)
{
*__ierr = MPI_Win_fence ((int)*assert, MPI_Win_f2c(*win));
}
