void ompi_allgatherv_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
char *recvbuf, MPI_Fint *recvcounts, MPI_Fint *displs,
MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr)
{
MPI_Comm c_comm;
MPI_Datatype c_sendtype, c_recvtype;
int size, ierr_c;
OMPI_ARRAY_NAME_DECL(recvcounts);
OMPI_ARRAY_NAME_DECL(displs);
c_comm = MPI_Comm_f2c(*comm);
c_sendtype = MPI_Type_f2c(*sendtype);
c_recvtype = MPI_Type_f2c(*recvtype);
MPI_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);
ierr_c = MPI_Allgatherv(sendbuf,
OMPI_FINT_2_INT(*sendcount),
c_sendtype,
recvbuf,
OMPI_ARRAY_NAME_CONVERT(recvcounts),
OMPI_ARRAY_NAME_CONVERT(displs),
c_recvtype, c_comm);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
OMPI_ARRAY_FINT_2_INT_CLEANUP(displs);
}
void mpi_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 = MPI_File_f2c(*fh);
MPI_Datatype c_etype = MPI_Type_f2c(*etype);
MPI_Datatype c_filetype = MPI_Type_f2c(*filetype);
MPI_Info c_info = MPI_Info_f2c(*info);
char *c_datarep;
int c_err, ret;
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
&c_datarep))) {
c_err = OMPI_ERRHANDLER_INVOKE(c_fh, ret, "MPI_FILE_SET_VIEW");
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
*ierr = OMPI_INT_2_FINT(MPI_File_set_view(c_fh, (MPI_Offset) *disp,
c_etype, c_filetype,
c_datarep, c_info));
free(c_datarep);
}
void mpi_sendrecv_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
MPI_Fint *dest, MPI_Fint *sendtag, char *recvbuf,
MPI_Fint *recvcount, MPI_Fint *recvtype,
MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm,
MPI_Fint *status, MPI_Fint *ierr)
{
MPI_Comm c_comm;
MPI_Datatype c_sendtype = MPI_Type_f2c(*sendtype);
MPI_Datatype c_recvtype = MPI_Type_f2c(*recvtype);
MPI_Status c_status;
c_comm = MPI_Comm_f2c (*comm);
*ierr = OMPI_INT_2_FINT(MPI_Sendrecv(OMPI_F2C_BOTTOM(sendbuf), OMPI_FINT_2_INT(*sendcount),
c_sendtype,
OMPI_FINT_2_INT(*dest),
OMPI_FINT_2_INT(*sendtag),
OMPI_F2C_BOTTOM(recvbuf), *recvcount,
c_recvtype, OMPI_FINT_2_INT(*source),
OMPI_FINT_2_INT(*recvtag),
c_comm, &c_status));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr) &&
!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
MPI_Status_c2f(&c_status, status);
}
}
void ompi_ialltoall_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)
{
int c_ierr;
MPI_Comm c_comm;
MPI_Request c_req;
MPI_Datatype c_sendtype, c_recvtype;
c_comm = MPI_Comm_f2c(*comm);
c_sendtype = MPI_Type_f2c(*sendtype);
c_recvtype = MPI_Type_f2c(*recvtype);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = MPI_Ialltoall(sendbuf,
OMPI_FINT_2_INT(*sendcount),
c_sendtype,
recvbuf,
OMPI_FINT_2_INT(*recvcount),
c_recvtype, c_comm, &c_req);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
if (MPI_SUCCESS == c_ierr) *request = MPI_Request_c2f(c_req);
}
void ompi_ineighbor_allgather_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)
{
int ierr_c;
MPI_Comm c_comm;
MPI_Request c_req;
MPI_Datatype c_sendtype, c_recvtype;
c_comm = MPI_Comm_f2c(*comm);
c_sendtype = MPI_Type_f2c(*sendtype);
c_recvtype = MPI_Type_f2c(*recvtype);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
ierr_c = MPI_Ineighbor_allgather(sendbuf,
OMPI_FINT_2_INT(*sendcount),
c_sendtype,
recvbuf,
OMPI_FINT_2_INT(*recvcount),
c_recvtype, c_comm, &c_req);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);
if (MPI_SUCCESS == ierr_c) *request = MPI_Request_c2f(c_req);
}
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 = MPI_Comm_f2c(*comm);
c_sendtype = MPI_Type_f2c(*sendtype);
c_recvtype = MPI_Type_f2c(*recvtype);
MPI_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 = MPI_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 = MPI_Request_c2f(c_request);
}
void mpi_scatterv_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 *ierr)
{
MPI_Comm c_comm;
MPI_Datatype c_sendtype, c_recvtype;
int size;
OMPI_ARRAY_NAME_DECL(sendcounts);
OMPI_ARRAY_NAME_DECL(displs);
c_comm = MPI_Comm_f2c(*comm);
c_sendtype = MPI_Type_f2c(*sendtype);
c_recvtype = MPI_Type_f2c(*recvtype);
MPI_Comm_size(c_comm, &size);
OMPI_ARRAY_FINT_2_INT(sendcounts, 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);
*ierr = OMPI_INT_2_FINT(MPI_Scatterv(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));
OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts);
OMPI_ARRAY_FINT_2_INT_CLEANUP(displs);
}
void mpi_allgatherv (void *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
void *recvbuf, MPI_Fint *recvcounts, MPI_Fint *displs,
MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *__ierr)
{
*__ierr = MPI_Allgatherv (sendbuf, *sendcount, MPI_Type_f2c (*sendtype),
recvbuf, recvcounts, displs,
MPI_Type_f2c (*recvtype), MPI_Comm_f2c (*comm));
}
void mpi_alltoall (void *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
void *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
MPI_Fint *comm, MPI_Fint *__ierr)
{
*__ierr = MPI_Alltoall (sendbuf, *sendcount, MPI_Type_f2c(*sendtype),
recvbuf, *recvcount, MPI_Type_f2c(*recvtype),
MPI_Comm_f2c (*comm));
}
void mpi_scatter (void *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
void *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
MPI_Fint *root, MPI_Fint *comm, MPI_Fint *__ierr)
{
*__ierr = MPI_Scatter (sendbuf, *sendcount, MPI_Type_f2c (*sendtype),
recvbuf, *recvcount, MPI_Type_f2c (*recvtype),
*root, MPI_Comm_f2c (*comm));
}
void mpi_scatterv (void *sendbuf, MPI_Fint *sendcnts, MPI_Fint *displs,
MPI_Fint *sendtype, void *recvbuf, MPI_Fint *recvcnt,
MPI_Fint *recvtype, MPI_Fint *root, MPI_Fint *comm,
MPI_Fint *__ierr )
{
*__ierr = MPI_Scatterv (sendbuf, sendcnts, displs, MPI_Type_f2c (*sendtype),
recvbuf, *recvcnt, MPI_Type_f2c (*recvtype), *root,
MPI_Comm_f2c (*comm));
}
void mpi_alltoallv (void *sendbuf, MPI_Fint *sendcnts, MPI_Fint *sdispls,
MPI_Fint *sendtype, void *recvbuf, MPI_Fint *recvcnts,
MPI_Fint *rdispls, MPI_Fint *recvtype, MPI_Fint *comm,
MPI_Fint *__ierr)
{
*__ierr = MPI_Alltoallv (sendbuf, sendcnts, sdispls,
MPI_Type_f2c (*sendtype), recvbuf,
recvcnts, rdispls, MPI_Type_f2c (*recvtype),
MPI_Comm_f2c (*comm));
}
void mpi_file_get_view_(MPI_Fint * fh, MPI_Offset * disp, MPI_Fint * etype,
MPI_Fint * filetype, _fcd datarep_fcd, MPI_Fint * ierr)
{
char *datarep = _fcdtocp(datarep_fcd);
int str_len = _fcdlen(datarep_fcd);
#else
/* Prototype to keep compiler happy */
FORTRAN_API void FORT_CALL mpi_file_get_view_(MPI_Fint * fh, MPI_Offset * disp, MPI_Fint * etype,
MPI_Fint * filetype,
char *datarep FORT_MIXED_LEN_DECL,
MPI_Fint * ierr FORT_END_LEN_DECL);
FORTRAN_API void FORT_CALL mpi_file_get_view_(MPI_Fint * fh, MPI_Offset * disp, MPI_Fint * etype,
MPI_Fint * filetype,
char *datarep FORT_MIXED_LEN(str_len),
MPI_Fint * ierr FORT_END_LEN(str_len))
{
#endif
MPI_File fh_c;
int i, tmpreplen;
MPI_Datatype etype_c, filetype_c;
char *tmprep;
/* Initialize the string to all blanks */
if (datarep <= (char *) 0) {
FPRINTF(stderr, "MPI_File_get_view: datarep is an invalid address\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
tmprep = (char *) ADIOI_Malloc((MPI_MAX_DATAREP_STRING + 1) * sizeof(char));
fh_c = MPI_File_f2c(*fh);
etype_c = MPI_Type_f2c(*etype);
filetype_c = MPI_Type_f2c(*filetype);
*ierr = MPI_File_get_view(fh_c, disp, &etype_c, &filetype_c, tmprep);
tmpreplen = strlen(tmprep);
if (tmpreplen <= str_len) {
ADIOI_Strncpy(datarep, tmprep, tmpreplen);
/* blank pad the remaining space */
for (i = tmpreplen; i < str_len; i++)
datarep[i] = ' ';
} else {
/* not enough space */
ADIOI_Strncpy(datarep, tmprep, str_len);
/* this should be flagged as an error. */
*ierr = MPI_ERR_UNKNOWN;
}
*etype = MPI_Type_c2f(etype_c);
*filetype = MPI_Type_c2f(filetype_c);
ADIOI_Free(tmprep);
}
void mpi_sendrecv (void *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
MPI_Fint *dest, MPI_Fint *sendtag,
void *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
MPI_Fint *source, MPI_Fint *recvtag,
MPI_Fint *comm, MPI_Fint *status, MPI_Fint *__ierr)
{
MPI_Status s;
*__ierr = MPI_Sendrecv (sendbuf, *sendcount, MPI_Type_f2c (*sendtype),
*dest, *sendtag, recvbuf, *recvcount,
MPI_Type_f2c (*recvtype), *source, *recvtag,
MPI_Comm_f2c (*comm), &s);
MPI_Status_c2f (&s, status);
}
void mpi_reduce_scatter_f(char *sendbuf, char *recvbuf,
MPI_Fint *recvcounts, MPI_Fint *datatype,
MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr)
{
MPI_Comm c_comm;
MPI_Datatype c_type;
MPI_Op c_op;
int size;
OMPI_ARRAY_NAME_DECL(recvcounts);
c_comm = MPI_Comm_f2c(*comm);
c_type = MPI_Type_f2c(*datatype);
c_op = MPI_Op_f2c(*op);
MPI_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);
*ierr = OMPI_INT_2_FINT(MPI_Reduce_scatter(sendbuf, recvbuf,
OMPI_ARRAY_NAME_CONVERT(recvcounts),
c_type, c_op, c_comm));
}
void mpi_type_get_extent_f(MPI_Fint *type, MPI_Aint *lb,
MPI_Aint *extent, MPI_Fint *ierr)
{
MPI_Datatype c_type = MPI_Type_f2c(*type);
*ierr = OMPI_INT_2_FINT(MPI_Type_get_extent(c_type, lb, extent));
}
void mpi_type_set_name_f(MPI_Fint *type, char *type_name, MPI_Fint *ierr,
int name_len)
{
int ret, c_err;
char *c_name;
MPI_Datatype c_type;
c_type = MPI_Type_f2c(*type);
/* Convert the fortran string */
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(type_name, name_len,
&c_name))) {
c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
"MPI_TYPE_SET_NAME");
*ierr = OMPI_INT_2_FINT(c_err);
return;
}
/* Call the C function */
*ierr = OMPI_INT_2_FINT(MPI_Type_set_name(c_type, c_name));
/* Free the C name */
free(c_name);
}
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 = MPI_Type_f2c(*datatype);
c_op = MPI_Op_f2c(*op);
c_comm = MPI_Comm_f2c(*comm);
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = MPI_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 = MPI_Request_c2f(c_request);
}
void ompi_type_indexed_f(MPI_Fint *count, MPI_Fint *array_of_blocklengths,
MPI_Fint *array_of_displacements, MPI_Fint *oldtype,
MPI_Fint *newtype, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_old = MPI_Type_f2c(*oldtype);
MPI_Datatype c_new;
OMPI_ARRAY_NAME_DECL(array_of_blocklengths);
OMPI_ARRAY_NAME_DECL(array_of_displacements);
OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count);
OMPI_ARRAY_FINT_2_INT(array_of_displacements, *count);
c_ierr = MPI_Type_indexed(OMPI_FINT_2_INT(*count),
OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths),
OMPI_ARRAY_NAME_CONVERT(array_of_displacements),
c_old, &c_new);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths);
OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_displacements);
if (MPI_SUCCESS == c_ierr) {
*newtype = MPI_Type_c2f(c_new);
}
}
int f2ctype_(MPI_Fint * fhandle, MPI_Fint * typeidx)
{
int errs = 0;
MPI_Datatype ctype;
/* printf("Testing %s\n", mpi_names[*typeidx].name); */
ctype = MPI_Type_f2c(*fhandle);
if (ctype != mpi_names[*typeidx].dtype) {
char mytypename[MPI_MAX_OBJECT_NAME];
int mytypenamelen;
/* An implementation is not *required* to deliver the
* corresponding C version of the MPI Datatype bit-for-bit. But
* if *must* act like it - e.g., the datatype name must be the same */
MPI_Type_get_name(ctype, mytypename, &mytypenamelen);
if (strcmp(mytypename, mpi_names[*typeidx].name) != 0 &&
/* LONG_LONG is a synonym of LONG_LONG_INT, thus LONG_LONG_INT is also a vaild name */
(ctype != MPI_LONG_LONG || strcmp(mytypename, "MPI_LONG_LONG_INT") != 0)) {
errs++;
printf("C and Fortran types for %s (c name is %s) do not match f=%d, ctof=%d.\n",
mpi_names[*typeidx].name, mytypename, *fhandle, MPI_Type_c2f(ctype));
}
}
return errs;
}
void mpi_reduce (void *sendbuf, void *recvbuf, MPI_Fint *count,
MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *root,
MPI_Fint *comm, MPI_Fint *__ierr)
{
*__ierr = MPI_Reduce (sendbuf, recvbuf, *count, MPI_Type_f2c(*datatype),
MPI_Op_f2c(*op), *root, MPI_Comm_f2c(*comm));
}
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 = MPI_Comm_f2c(*comm);
c_type = MPI_Type_f2c(*datatype);
c_op = MPI_Op_f2c(*op);
MPI_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 = MPI_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 = MPI_Request_c2f(c_request);
}
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 = MPI_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 = MPI_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 = MPI_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 csetmpitype_( MPI_Fint *ftype, MPI_Fint *fkey, MPI_Aint *val,
MPI_Fint *errs )
{
MPI_Datatype dtype = MPI_Type_f2c( *ftype );
MPI_Type_set_attr( dtype, *fkey, (void *)*val );
}
void cmpif2readtype_( MPI_Fint *ftype, MPI_Fint *fkey, MPI_Aint *expected,
MPI_Fint *errs, const char *msg, int msglen )
{
void *attrval;
int flag, result;
MPI_Datatype dtype = MPI_Type_f2c( *ftype );
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_Type_get_attr( dtype, *fkey, &attrval, &flag );
if (!flag) {
*errs = *errs + 1;
strncpy( lmsg, msg, msglen );
lmsg[msglen] = 0;
printf( " Error: flag false for Type_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/Type) expected %ld but saw %ld: %s\n",
(long)*expected, (long)*(MPI_Aint*)attrval, lmsg );
return;
}
return;
}
void mpi_alltoallv (void *sendbuf, int *sendcounts, int *sdispls, MPI_Fint *sendtype, void *recvbuf, int *recvcounts, int *rdispls, MPI_Fint *recvtype, MPI_Fint *comm,int *ierr)
{
__SHIM__REGISTER_F(Alltoallv);
caller = __SHIM__get_caller();
MPI_Datatype cb_sendtype, cb_recvtype;
MPI_Comm cb_comm;
cb_sendtype = MPI_Type_f2c(*sendtype);
cb_recvtype = MPI_Type_f2c(*recvtype);
cb_comm = MPI_Comm_f2c(*comm);
tor_MPI_Alltoallv_pre(sendbuf, sendcounts, sdispls, cb_sendtype, recvbuf, recvcounts, rdispls, cb_recvtype, cb_comm,caller);
__SHIM__FUNC_F(sendbuf, sendcounts,sdispls, sendtype, recvbuf, recvcounts, rdispls, recvtype, comm, ierr);
tor_MPI_Alltoallv_pos(sendbuf, sendcounts, sdispls, cb_sendtype, recvbuf, recvcounts, rdispls, cb_recvtype, cb_comm,caller,*ierr);
return;
}
FORTRAN_API void FORT_CALL mpi_pack_size_ ( MPI_Fint *incount, MPI_Fint *datatype, MPI_Fint *comm, MPI_Fint *size, MPI_Fint *__ierr )
{
int lsize;
*__ierr = MPI_Pack_size((int)*incount, MPI_Type_f2c(*datatype),
MPI_Comm_f2c(*comm), &lsize);
*size = (MPI_Fint)lsize;
}
PETSC_EXTERN void PETSC_STDCALL dmplexdistributedata_(DM dm,PetscSF pointSF,PetscSection originalSection,MPI_Fint * datatype,void*originalData,PetscSection newSection,void**newData, int *__ierr ){
*__ierr = DMPlexDistributeData(
(DM)PetscToPointer((dm) ),
(PetscSF)PetscToPointer((pointSF) ),
(PetscSection)PetscToPointer((originalSection) ),
MPI_Type_f2c(*(datatype)),originalData,
(PetscSection)PetscToPointer((newSection) ),newData);
}
void ompi_neighbor_alltoallw_f(char *sendbuf, MPI_Fint *sendcounts,
MPI_Aint *sdispls, MPI_Fint *sendtypes,
char *recvbuf, MPI_Fint *recvcounts,
MPI_Aint *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(recvcounts);
c_comm = MPI_Comm_f2c(*comm);
MPI_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(recvcounts, size);
while (size > 0) {
c_sendtypes[size - 1] = MPI_Type_f2c(sendtypes[size - 1]);
c_recvtypes[size - 1] = MPI_Type_f2c(recvtypes[size - 1]);
--size;
}
/* Alltoallw does not support MPI_IN_PLACE */
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
c_ierr = MPI_Neighbor_alltoallw(sendbuf,
OMPI_ARRAY_NAME_CONVERT(sendcounts),
sdispls,
c_sendtypes,
recvbuf,
OMPI_ARRAY_NAME_CONVERT(recvcounts),
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(recvcounts);
free(c_sendtypes);
free(c_recvtypes);
}
void ompi_type_get_true_extent_x_f(MPI_Fint *datatype, MPI_Count *true_lb, MPI_Count *true_extent, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
c_ierr = MPI_Type_get_true_extent_x(c_type, true_lb, true_extent);
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
