/*==========================================================================*/
int PMPI_Scatter (void *sendbuf, int sendcnt, MPI_Datatype sendtype, void *recvbuf,
int recvcnt, MPI_Datatype recvtype, int root, MPI_Comm comm)
{
int sendsize, recvsize, retval;
_MPI_COVERAGE();
_MPI_CHECK_STATUS(&comm);
retval = _MPI_checks(sendbuf, sendcnt, sendtype, _MPI_RANK, MPI_ANY_TAG, comm);
if (retval != MPI_SUCCESS)
return retval;
retval = _MPI_checks(recvbuf,recvcnt,recvtype, _MPI_RANK, MPI_ANY_TAG, comm);
if (retval == MPI_SUCCESS)
{
recvsize = _MPI_calculateSize(recvcnt, recvtype);
sendsize = _MPI_calculateSize(sendcnt, sendtype);
if (recvsize < sendsize) /*MESSAGE IS TRUNCATED*/
{
recvbuf = memcpy(recvbuf, sendbuf, recvsize);
printf("MPI_RECV : Message truncated.\n");
MPI_Abort(comm, MPI_ERR_COUNT);
return MPI_ERR_COUNT;
} else {
recvbuf = memcpy(recvbuf, sendbuf, sendsize);
}
}
_MPI_COVERAGE();
return _MPI_NOT_OK;
}
/* Same behavior as PMPI_Irsend.c */
int PMPI_Issend (void* message, int count, MPI_Datatype datatype, int dest,
int tag, MPI_Comm comm, MPI_Request* request)
{
int size, retval, index;
char* p;
_MPI_COVERAGE();
_MPI_CHECK_STATUS(&comm);
retval = _MPI_checkRequest(*request);
if ( retval!=MPI_SUCCESS ) {
_MPI_Set_Request(request, message, count, datatype, _MPI_TRUE, tag, comm);
}
retval = _MPI_checks(message, count, datatype, dest, tag, comm);
if (retval == MPI_SUCCESS) {
index = _MPI_Req_Find(tag, comm);
if ( index >= 0 ) {
size = _MPI_calculateSize(count, datatype);
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
p = memcpy(p, message, size);
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
return MPI_ERR_PENDING;
} else {
_MPI_ERR_ROUTINE (retval, "MPI_ISSEND / MPI_IRSEND: argument error");
MPI_Abort (comm, retval);
}
_MPI_COVERAGE();
return retval;
}
/*=============================================================================================*/
int PMPI_Msend (void* message, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm)
{
int size, retval;
char* p;
/* option 1: Assert( _MPI_IS_INITIALIZED() ); */
_MPI_COVERAGE();
_MPI_CHECK_STATUS(&comm);
retval = _MPI_checks(message, count, datatype, dest, tag, comm);
/* option 2: STANDARD_MPI_CHECK(comm); */
if (retval == MPI_SUCCESS)
{
size = _MPI_calculateSize(count, datatype);
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
p = memcpy(p, message, size);
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
} else {
_MPI_ERR_ROUTINE (retval, "MPI_SEND / MPI_ISEND: argument error");
MPI_Abort (comm, retval);
}
_MPI_COVERAGE();
return _MPI_NOT_OK;
}
/*==========================================================================*/
int PMPI_Irecv (void* message, int count, MPI_Datatype datatype, int source,
int tag, MPI_Comm comm, MPI_Request* request)
{
int retval, req;
retval=_MPI_checks(message, count, datatype, source, tag, comm);
if (retval != MPI_SUCCESS) {
_MPI_ERR_ROUTINE (retval, "MPI_IRECV: argument error");
MPI_Abort (comm, retval);
return retval;
}
#if 0
/* Not sure what this is doing.... */
if (*request == MPI_REQUEST_NULL) {
_MPI_Set_Request(request, message, count, datatype, _MPI_FALSE, tag, comm);/* KDDKDD Passing request pointer */
}
#endif
if (retval == MPI_SUCCESS) {
/* Check for New Request and Insert it into the Request queque */
#if 0
/* TODO: WHAT IS THIS DOING? */
req = _MPI_Req_Find(tag, comm);
#else
req = -1;
#endif
if ( req < 0 ) { /* It is a new request */
req = _MPI_Req_Post(message, count, datatype, tag, comm, _MPI_FALSE);
*request = &_MPI_REQ_LIST[req];
}
#if 0
/* TODO: This should wait until for the "wait" */
size = _MPI_calculateSize(count, datatype);
index = _MPI_Buff_Ifind(tag, comm);
if (index == _MPI_NOT_OK) {
return MPI_ERR_PENDING;
}
/*MESSAGE IS THERE*/
_MPI_Req_Invalid(req);
if (size < _MPI_DATA_BUFF[index].size) { /*MESSAGE IS TRUNCATED */
message = memcpy(message, _MPI_DATA_BUFF[index].buffer, size);
printf("MPI_RECV : Message truncated.\n");
MPI_Abort(comm, MPI_ERR_COUNT);
} else {
message = memcpy(message, _MPI_DATA_BUFF[index].buffer, size);
}
_MPI_Data_Invalid(index);
return MPI_SUCCESS;
#endif
}
return retval;
}
/*==========================================================================*/
int PMPI_Recv (void* message, int count, MPI_Datatype datatype, int source,
int tag, MPI_Comm comm, MPI_Status* status)
{
int retval, receiver_size, message_size, index;
retval=_MPI_checks(message, count, datatype, source, tag, comm);
if (retval == MPI_SUCCESS) {
receiver_size = _MPI_calculateSize(count, datatype);
/* ----------------------------------------------- */
/* Look up the send that matches this receive */
/* ----------------------------------------------- */
index = _MPI_Buff_Find(tag, comm);
if (index == _MPI_NOT_OK) {
return MPI_ERR_TAG; /* this return value is relied upon by some */
} /* internal calls to indicate no matching send */
message_size = _MPI_calculateSize(_MPI_DATA_BUFF[index].count,
_MPI_DATA_BUFF[index].type);
if (status != MPI_STATUS_IGNORE) {
status->MPI_SOURCE = _MPI_RANK;
status->MPI_TAG = _MPI_DATA_BUFF[index].tag;
status->__count = message_size;
}
if (message_size > receiver_size) {
_MPI_ERR_ROUTINE(MPI_ERR_COUNT, "MPI_RECV : Message buffer too small for message");
if (status != MPI_STATUS_IGNORE) status->MPI_ERROR = MPI_ERR_COUNT;
_MPI_Data_Invalid(index);
return MPI_ERR_COUNT;
}
memcpy(message, _MPI_DATA_BUFF[index].buffer, message_size);
if (status != MPI_STATUS_IGNORE) status->MPI_ERROR = MPI_SUCCESS;
_MPI_Data_Invalid(index);
return MPI_SUCCESS;
}
return retval;
}
/*==========================================================================*/
int PMPI_Reduce ( void *sendbuf, void *recvbuf, int count,
MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm )
{
int size;
int retval;
_MPI_COVERAGE();
/* ----------------------------------------------- */
/* We shortcut on length 0 sends since there is no */
/* work to do... */
/* ----------------------------------------------- */
if ( count == 0 ) return MPI_SUCCESS;
/* ----------------------------------------------- */
/* First we verify that the sendbuf, recvbuf, and */
/* operator are OK. */
/* ----------------------------------------------- */
retval = _MPI_checks(sendbuf, count, datatype, root, 1, comm);
if ( retval != MPI_SUCCESS ) {
_MPI_ERR_ROUTINE (MPI_ERR_OTHER, "MPI_REDUCE : Invalid argument");
MPI_Abort(comm, retval);
return _MPI_NOT_OK;
}
if ( _MPI_checkBuffer(recvbuf) != MPI_SUCCESS ) {
_MPI_ERR_ROUTINE (MPI_ERR_BUFFER, "MPI_REDUCE : Invalid buffer pointer");
MPI_Abort(comm, MPI_ERR_BUFFER);
return _MPI_NOT_OK;
}
if ( _MPI_checkOp(op) != MPI_SUCCESS ) {
_MPI_ERR_ROUTINE(MPI_ERR_OP, "MPI_REDUCE : Invalid MPI_Op");
MPI_Abort(comm, MPI_ERR_OP);
return _MPI_NOT_OK;
}
/* ----------------------------------------------- */
/* Guard against buffer overlap... */
/* ----------------------------------------------- */
size = _MPI_calculateSize(count, datatype);
if ( _MPI_check_overlap(sendbuf, recvbuf, size) != MPI_SUCCESS ) {
_MPI_ERR_ROUTINE (MPI_ERR_BUFFER, "MPI_REDUCE : Invalid buffer pointer: Arguments must specify different buffers (no aliasing)");
MPI_Abort(comm, MPI_ERR_BUFFER);
return _MPI_NOT_OK;
}
#if 0
/* KDDKDD: This initialization isn't right, particularly for
* KDDKDD: user-defined functions that do comparisons of in with inout.
* KDDKDD: I'm not sure what the correct initialization is, though.
* KDDKDD: Nor am I sure what the symantics of MPI require; that is,
* KDDKDD: should the user initialization inout (and we just got lucky
* KDDKDD: on other platforms)?
* KDDKDD: Anyway, this initialization to zero causes
* KDDKDD: ch_simple/zdrive.inp.rcb-partlocal2 to go infinite due to
* KDDKDD: faulty box merge.
*/
/* ----------------------------------------------- */
/* We zero out the buffer since some users expect */
/* it to be initialized. */
/* ----------------------------------------------- */
memset(recvbuf,0,size);
#endif
/* ----------------------------------------------- */
/* Now, we call the function */
/* ----------------------------------------------- */
#if 0
/* KDDKDD: On one processor, MPICH and LAM both do only a copy of
* KDDKDD: sendbuf to recvbuf. They do not call user-defined functions.
* KDDKDD: This choice may not be correct on their part, but siMPI should
* KDDKDD: probably do the same (for consistency).
*/
if ( op>MPI_MAXLOC ) {
(_MPI_OP_LIST[op-_MPI_OP_OFFSET].function)(sendbuf, recvbuf, &count, &datatype);
} else
#endif
{
_MPI_Default_Op(sendbuf, recvbuf, &count, &datatype);
}
return MPI_SUCCESS;
}
/*=============================================================================================*/
int PMPI_Send (void* message, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) {
int size, retval, sendType, index;
MPI_Aint position, copiedPointer;
_MPI_TYPE_INFO *info;
char* p;
_MPI_COVERAGE();
_MPI_CHECK_STATUS(&comm);
retval = _MPI_checks(message, count, datatype, dest, tag, comm);
if (retval == MPI_SUCCESS) {
sendType = _MPI_checkSendType(datatype);
switch (sendType) {
case _MPI_DEFAULT:
{
size = _MPI_calculateSize(count, datatype);
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
p = memcpy(p, message, size);
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_CONTIG:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
p = memcpy(p, message, size);
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_INDEXED:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
/* ================================================== */
/* Determine the correct parts to save to the buffers */
info = _MPI_TYPE_LIST[sendType].info;
position = (MPI_Aint) 0;
copiedPointer = (MPI_Aint) 0;
for (index = 0; index < info->count; index++)
{
position = info->stride[index]*sizeof(info->types[0]);
p = memcpy(p+copiedPointer, ((char*)message)+position, info->blocklen[index]*sizeof(info->types[0]));
copiedPointer += info->blocklen[index]*sizeof(info->types[0]);
}
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_VECTOR:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
/* =================================== */
/* Figure out the correct ones to pass */
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_STRUCT:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
/* =================================== */
/* Figure out the correct ones to pass */
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
default:
{
fprintf(stderr,"SEND: mpi_Hindexed or mpi_Hvector not implemented\n");
MPI_Abort (comm, _MPI_NOT_OK);
}
}
} else {
_MPI_ERR_ROUTINE (retval, "MPI_SEND / MPI_ISEND: argument error");
MPI_Abort (comm, retval);
}
_MPI_COVERAGE();
return _MPI_NOT_OK;
}
