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_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 ompi_file_set_info_f(MPI_Fint *fh, MPI_Fint *info, MPI_Fint *ierr)
{
int c_ierr;
MPI_File c_fh = PMPI_File_f2c(*fh);
MPI_Info c_info = PMPI_Info_f2c(*info);
c_ierr = PMPI_File_set_info(c_fh, c_info);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
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);
}
}
void ompi_info_dup_f(MPI_Fint *info, MPI_Fint *newinfo, MPI_Fint *ierr)
{
int c_ierr;
MPI_Info c_info, c_new_info;
c_info = PMPI_Info_f2c(*info);
c_ierr = PMPI_Info_dup(c_info, &c_new_info);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) {
*newinfo = PMPI_Info_c2f(c_new_info);
}
}
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_info_get_nthkey_f(MPI_Fint *info, MPI_Fint *n, char *key,
MPI_Fint *ierr, int key_len)
{
int c_ierr, ret;
MPI_Info c_info;
char c_key[MPI_MAX_INFO_KEY + 1];
c_info = PMPI_Info_f2c(*info);
c_ierr = PMPI_Info_get_nthkey(c_info,
OMPI_FINT_2_INT(*n),
c_key);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_key, key, key_len))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
}
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_file_delete_f(char *filename, MPI_Fint *info, MPI_Fint *ierr, int filename_len)
{
MPI_Info c_info;
char *c_filename;
int c_ierr, ret;
c_info = PMPI_Info_f2c(*info);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(filename, filename_len,
&c_filename))) {
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, ret, "MPI_FILE_DELETE");
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
return;
}
c_ierr = PMPI_File_delete(c_filename, c_info);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
free(c_filename);
}
void ompix_scatterv_init_f(char *sendbuf, MPI_Fint *sendcounts,
MPI_Fint *displs, MPI_Fint *sendtype,
char *recvbuf, MPI_Fint *recvcount,
MPI_Fint *recvtype, MPI_Fint *root,
MPI_Fint *comm, MPI_Fint *info, MPI_Fint *request, MPI_Fint *ierr)
{
MPI_Comm c_comm;
MPI_Datatype c_sendtype, c_recvtype;
MPI_Info c_info;
MPI_Request c_request;
int size, c_ierr;
OMPI_ARRAY_NAME_DECL(sendcounts);
OMPI_ARRAY_NAME_DECL(displs);
c_comm = PMPI_Comm_f2c(*comm);
c_sendtype = PMPI_Type_f2c(*sendtype);
c_recvtype = PMPI_Type_f2c(*recvtype);
c_info = PMPI_Info_f2c(*info);
PMPI_Comm_size(c_comm, &size);
OMPI_ARRAY_FINT_2_INT(sendcounts, size);
OMPI_ARRAY_FINT_2_INT(displs, size);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_IN_PLACE(recvbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = PMPIX_Scatterv_init(sendbuf,
OMPI_ARRAY_NAME_CONVERT(sendcounts),
OMPI_ARRAY_NAME_CONVERT(displs),
c_sendtype, recvbuf,
OMPI_FINT_2_INT(*recvcount),
c_recvtype,
OMPI_FINT_2_INT(*root), c_comm, c_info, &c_request);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request);
OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts);
OMPI_ARRAY_FINT_2_INT_CLEANUP(displs);
}
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_Info MPI_Info_f2c(MPI_Fint info){
return PMPI_Info_f2c(info);
}
MPI_Info MPI_Info_f2c(MPI_Fint info)
{
_MPI_COVERAGE();
return PMPI_Info_f2c (info);
}
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);
}
