static int set_f(int keyval, MPI_Fint value)
{
return ompi_attr_set_fortran_mpi1(COMM_ATTR, MPI_COMM_WORLD,
&MPI_COMM_WORLD->c_keyhash,
keyval, value,
true, true);
}
static int
config_window(void *base, size_t size, int disp_unit,
int flavor, int model, ompi_win_t *win)
{
int ret;
ret = ompi_attr_set_c(WIN_ATTR, win, &win->w_keyhash,
MPI_WIN_BASE, base, true);
if (OMPI_SUCCESS != ret) return ret;
ret = ompi_attr_set_fortran_mpi2(WIN_ATTR, win,
&win->w_keyhash,
MPI_WIN_SIZE, size, true);
if (OMPI_SUCCESS != ret) return ret;
ret = ompi_attr_set_fortran_mpi1(WIN_ATTR, win,
&win->w_keyhash,
MPI_WIN_DISP_UNIT, disp_unit,
true);
if (OMPI_SUCCESS != ret) return ret;
ret = ompi_attr_set_fortran_mpi1(WIN_ATTR, win,
&win->w_keyhash,
MPI_WIN_CREATE_FLAVOR, flavor, true);
if (OMPI_SUCCESS != ret) return ret;
ret = ompi_attr_set_fortran_mpi1(WIN_ATTR, win,
&win->w_keyhash,
MPI_WIN_MODEL, model, true);
if (OMPI_SUCCESS != ret) return ret;
win->w_f_to_c_index = opal_pointer_array_add(&ompi_mpi_windows, win);
if (-1 == win->w_f_to_c_index) return OMPI_ERR_OUT_OF_RESOURCE;
return OMPI_SUCCESS;
}
int MPI_Add_error_code(int errorclass, int *errorcode)
{
int code;
int rc;
OPAL_CR_NOOP_PROGRESS();
if ( MPI_PARAM_CHECK ) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
if ( ompi_mpi_errcode_is_invalid(errorclass) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
if ( !ompi_mpi_errnum_is_class ( errorclass) )
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
FUNC_NAME);
if (NULL == errorcode) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD,
MPI_ERR_ARG, FUNC_NAME);
}
}
code = ompi_mpi_errcode_add ( errorclass);
if ( 0 > code ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INTERN,
FUNC_NAME);
}
/*
** Update the attribute value. See the comments
** in attribute/attribute.c and attribute/attribute_predefined.c
** why we have to call the fortran attr_set function
*/
rc = ompi_attr_set_fortran_mpi1 (COMM_ATTR,
MPI_COMM_WORLD,
&MPI_COMM_WORLD->c_keyhash,
MPI_LASTUSEDCODE,
ompi_mpi_errcode_lastused,
true);
if ( MPI_SUCCESS != rc ) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, rc, FUNC_NAME);
}
*errorcode = code;
return MPI_SUCCESS;
}
