int query_fn(void *extra_state, MPI_Status *status)
{
status->MPI_SOURCE = MPI_UNDEFINED;
status->MPI_TAG = MPI_UNDEFINED;
MPI_Status_set_cancelled(status, 0);
MPI_Status_set_elements(status, MPI_BYTE, 0);
return 0;
}
FORT_DLL_SPEC void FORT_CALL mpi_status_set_elements_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *v3, MPI_Fint *ierr ){
#ifndef HAVE_MPI_F_INIT_WORKS_WITH_C
if (MPIR_F_NeedInit){ mpirinitf_(); MPIR_F_NeedInit = 0; }
#endif
if (v1 == MPI_F_STATUS_IGNORE) { v1 = (MPI_Fint*)MPI_STATUS_IGNORE; }
*ierr = MPI_Status_set_elements( (MPI_Status *)v1, (MPI_Datatype)(*v2), (int)*v3 );
}
/* TODO: still needs to handle partial datatypes and situations where the mpi
* implementation fills status with something other than bytes (globus2 might
* do this) */
int MPIR_Status_set_bytes(MPI_Status *status, MPI_Datatype datatype,
int nbytes)
{
ADIOI_UNREFERENCED_ARG(datatype);
/* it's ok that ROMIO stores number-of-bytes in status, not
* count-of-copies, as long as MPI_GET_COUNT knows what to do */
if (status != MPI_STATUS_IGNORE)
MPI_Status_set_elements(status, MPI_BYTE, nbytes);
return MPI_SUCCESS;
}
/*
* This function is required by ROMIO to set information on an Open
* MPI status. Conveniently, it maps directly to
* MPI_Status_set_elements (almost like they planned that... hmmm...).
*/
int MPIR_Status_set_bytes(ompi_status_public_t *status,
struct ompi_datatype_t *datatype, int nbytes)
{
/* Note that ROMIO is going to give a number of *bytes* here, but
MPI_STATUS_SET_ELEMENTS requires a number of *elements*. So
rather than try to do a conversion up here, just set the number
of bytes with MPI_CHAR as the datatype. If someone does a
GET_STATUS later, they have to supply their own datatype, and
we do the right calculations there. This prevents roundoff
errors here, potentially "losing" bytes in the process. */
MPI_Status_set_elements(status, MPI_CHAR, nbytes);
return MPI_SUCCESS;
}
int ADIOI_NTFS_aio_query_fn(void *extra_state, MPI_Status *status)
{
ADIOI_AIO_Request *aio_req;
aio_req = (ADIOI_AIO_Request *)extra_state;
MPI_Status_set_elements(status, MPI_BYTE, aio_req->nbytes);
/* can never cancel so always true */
MPI_Status_set_cancelled(status, 0);
/* choose not to return a value for this */
status->MPI_SOURCE = MPI_UNDEFINED;
/* tag has no meaning for this generalized request */
status->MPI_TAG = MPI_UNDEFINED;
/* this generalized request never fails */
return MPI_SUCCESS;
}
/*
* ADIOI_Sync_req_query - MPI_Grequest query callback function
*/
int ADIOI_Sync_req_query(void *extra_state, MPI_Status *status) {
ADIOI_Sync_req_t r = (ADIOI_Sync_req_t)extra_state;
int count;
int error_code;
MPI_Datatype datatype;
ADIOI_Sync_req_get_key(r, ADIOI_SYNC_ERR_CODE, &error_code);
ADIOI_Sync_req_get_key(r, ADIOI_SYNC_DATATYPE, &datatype);
ADIOI_Sync_req_get_key(r, ADIOI_SYNC_COUNT, &count);
MPI_Status_set_cancelled(status, 0);
if(error_code == MPI_SUCCESS)
MPI_Status_set_elements(status, datatype, count);
status->MPI_SOURCE = MPI_UNDEFINED;
status->MPI_TAG = MPI_UNDEFINED;
return error_code;
}
void mpi_status_set_elements_f(MPI_Fint *status, MPI_Fint *datatype,
MPI_Fint *count, MPI_Fint *ierr)
{
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
MPI_Status c_status;
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
MPI_Status_f2c( status, &c_status );
*ierr = OMPI_INT_2_FINT(MPI_Status_set_elements(&c_status, c_type,
OMPI_FINT_2_INT(*count)));
/* If datatype is really being set, then that needs to be
converted.... */
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
MPI_Status_c2f(&c_status, status);
}
}
}
static int _ZMPI_Alltoall_specific(void *sbuf, int scount, MPI_Datatype stype, void *rbuf, int rcount, MPI_Datatype rtype, ZMPI_Tproc tproc, void *tproc_data, int comm_size, int comm_rank, MPI_Comm comm,
#if MPI_VERSION >= 3
MPI_Status
#else
ZMPI_Status
#endif
*status, int type, const char *name)
{
int exit_code, received = 0;
spec_elem_t sb, rb, *b, *xb;
if (sbuf == MPI_IN_PLACE && rbuf == MPI_IN_PLACE)
{
#ifdef ZMPI_ALLTOALL_SPECIFIC_ERROR_FILE
fprintf(ZMPI_ALLTOALL_SPECIFIC_ERROR_FILE, "%d: %s: error: either sbuf or rbuf can be MPI_IN_PLACE!\n", comm_rank, name);
#endif
exit_code = ZMPI_FAILURE;
goto exit;
}
if (tproc == ZMPI_TPROC_NULL)
{
exit_code = MPI_SUCCESS;
goto exit;
}
if (sbuf != MPI_IN_PLACE)
{
sb.buf = sbuf;
sb.count = sb.max_count = scount;
sb.mpi_type = stype;
zmpil_create(&sb.zmpil_type, stype, 1);
b = &sb;
}
if (rbuf != MPI_IN_PLACE)
{
rb.buf = rbuf;
rb.count = rb.max_count = rcount;
rb.mpi_type = rtype;
zmpil_create(&rb.zmpil_type, rtype, 1);
b = &rb;
}
xb = NULL;
if (sbuf == MPI_IN_PLACE || rbuf == MPI_IN_PLACE)
{
b->count = scount;
b->max_count = rcount;
switch (type)
{
#ifdef SPEC_ALLTOALLV
case ZMPI_ALLTOALL_SPECIFIC_TYPE_ALLTOALLV:
exit_code = spec_alltoallv_ip(b, xb, tproc, tproc_data, comm_size, comm_rank, comm);
break;
#endif
default:
#ifdef ZMPI_ALLTOALL_SPECIFIC_ERROR_FILE
fprintf(ZMPI_ALLTOALL_SPECIFIC_ERROR_FILE, "%d: %s: error: in-place implementation of type %d is not available!\n", comm_rank, name);
#endif
exit_code = ZMPI_FAILURE;
break;
}
received = b->count;
} else {
switch (type)
{
#ifdef SPEC_ALLTOALLV
case ZMPI_ALLTOALL_SPECIFIC_TYPE_ALLTOALLV:
exit_code = spec_alltoallv_db(&sb, &rb, xb, tproc, tproc_data, comm_size, comm_rank, comm);
break;
#endif
#ifdef SPEC_ALLTOALLW
case ZMPI_ALLTOALL_SPECIFIC_TYPE_ALLTOALLW:
exit_code = spec_alltoallw_db(&sb, &rb, xb, tproc, tproc_data, comm_size, comm_rank, comm);
break;
#endif
#ifdef SPEC_PUT
case ZMPI_ALLTOALL_SPECIFIC_TYPE_PUT:
exit_code = spec_put_db(&sb, &rb, xb, tproc, tproc_data, comm_size, comm_rank, comm);
break;
case ZMPI_ALLTOALL_SPECIFIC_TYPE_PUT_2PHASES:
exit_code = spec_put_2phases_db(&sb, &rb, xb, tproc, tproc_data, comm_size, comm_rank, comm);
break;
#endif
#ifdef SPEC_SENDRECV
case ZMPI_ALLTOALL_SPECIFIC_TYPE_SENDRECV:
exit_code = spec_sendrecv_db(&sb, &rb, xb, tproc, tproc_data, comm_size, comm_rank, comm);
break;
#endif
default:
#ifdef ZMPI_ALLTOALL_SPECIFIC_ERROR_FILE
fprintf(ZMPI_ALLTOALL_SPECIFIC_ERROR_FILE, "%d: %s: error: implementation of type %d is not available!\n", comm_rank, name);
#endif
exit_code = ZMPI_FAILURE;
break;
}
received = rb.count;
}
zmpil_destroy(&sb.zmpil_type);
zmpil_destroy(&rb.zmpil_type);
exit:
#if MPI_VERSION >= 3
if (status != MPI_STATUS_IGNORE) MPI_Status_set_elements(status, rtype, received);
#else
if (status != ZMPI_STATUS_IGNORE) *status = received;
#endif
return exit_code;
}
