/*!
* \brief Wait for all send/receives of bufinfo to complete
* \param[in] node address of CommQueue node
* \return Return Code
*
* This routine is to be executed during the ::MB_COMM_OLD_BUFINFO_SENT stage.
*
* Steps:
* -# if node->pending_in != 0, MPI_Testall() receives
* - if completed, set node->pending_in = 0
* -# if node->pending_out != 0, MPI_Testall() sends
* - if completed, set node->pending_out = 0
* -# if node->pending_in == 0 and node->pending_out == 0
* - set node->stage = MB_COMM_OLD_PRE_PROPAGATION
*
* Post:
* - if node->pending_in == 0 and node->pending_out == 0
* - node->stage == MB_COMM_OLD_PRE_PROPAGATION
* - else
* - node->stage == MB_COMM_OLD_BUFINFO_SENT
*/
int MBI_CommRoutine_OLD_WaitBufInfo(struct MBIt_commqueue *node) {
int rc, flag;
assert(node->stage == MB_COMM_OLD_BUFINFO_SENT);
assert(node->outcount != NULL);
assert(node->incount != NULL);
assert(node->sendreq != NULL);
assert(node->recvreq != NULL);
assert(node->board != NULL);
/* check receives */
if (node->pending_in != 0)
{
rc = MPI_Testall(MBI_CommSize, node->recvreq, &flag, MPI_STATUSES_IGNORE);
assert(rc == MPI_SUCCESS);
if (rc != MPI_SUCCESS) return MB_ERR_MPI;
if (flag)
{
P_INFO("COMM: (Board %d) all buffer sizes received", node->mb);
node->pending_in = 0;
}
}
/* check sends */
if (node->pending_out != 0)
{
rc = MPI_Testall(MBI_CommSize, node->sendreq, &flag, MPI_STATUSES_IGNORE);
assert(rc == MPI_SUCCESS);
if (rc != MPI_SUCCESS) return MB_ERR_MPI;
if (flag)
{
P_INFO("COMM: (Board %d) all buffer sizes sent", node->mb);
node->pending_out = 0;
}
}
/* if all done, move on to next stage */
if (node->pending_in == 0 && node->pending_out == 0)
{
P_INFO("COMM: (Board %d) moving to MB_COMM_OLD_PRE_PROPAGATION stage", node->mb);
node->stage = MB_COMM_OLD_PRE_PROPAGATION;
}
return MB_SUCCESS;
}
dart_ret_t dart_testall_local(
dart_handle_t * handle,
size_t n,
int32_t * is_finished)
{
size_t i, r_n;
DART_LOG_DEBUG("dart_testall_local()");
MPI_Status *mpi_sta;
MPI_Request *mpi_req;
mpi_req = (MPI_Request *)malloc(n * sizeof (MPI_Request));
mpi_sta = (MPI_Status *)malloc(n * sizeof (MPI_Status));
r_n = 0;
for (i = 0; i < n; i++) {
if (handle[i]){
mpi_req[r_n] = handle[i] -> request;
r_n++;
}
}
MPI_Testall(r_n, mpi_req, is_finished, mpi_sta);
r_n = 0;
for (i = 0; i < n; i++) {
if (handle[i]) {
handle[i] -> request = mpi_req[r_n];
r_n++;
}
}
free(mpi_req);
free(mpi_sta);
DART_LOG_DEBUG("dart_testall_local > finished");
return DART_OK;
}
static PetscErrorCode PetscCommBuildTwoSided_Ibarrier(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
{
PetscErrorCode ierr;
PetscMPIInt nrecvs,tag,done,i;
MPI_Aint lb,unitbytes;
char *tdata;
MPI_Request *sendreqs,barrier;
PetscSegBuffer segrank,segdata;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = MPI_Type_get_extent(dtype,&lb,&unitbytes);CHKERRQ(ierr);
if (lb != 0) SETERRQ1(comm,PETSC_ERR_SUP,"Datatype with nonzero lower bound %ld\n",(long)lb);
tdata = (char*)todata;
ierr = PetscMalloc1(nto,&sendreqs);CHKERRQ(ierr);
for (i=0; i<nto; i++) {
ierr = MPI_Issend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
ierr = PetscSegBufferCreate(sizeof(PetscMPIInt),4,&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferCreate(unitbytes,4*count,&segdata);CHKERRQ(ierr);
nrecvs = 0;
barrier = MPI_REQUEST_NULL;
for (done=0; !done; ) {
PetscMPIInt flag;
MPI_Status status;
ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag,comm,&flag,&status);CHKERRQ(ierr);
if (flag) { /* incoming message */
PetscMPIInt *recvrank;
void *buf;
ierr = PetscSegBufferGet(segrank,1,&recvrank);CHKERRQ(ierr);
ierr = PetscSegBufferGet(segdata,count,&buf);CHKERRQ(ierr);
*recvrank = status.MPI_SOURCE;
ierr = MPI_Recv(buf,count,dtype,status.MPI_SOURCE,tag,comm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
nrecvs++;
}
if (barrier == MPI_REQUEST_NULL) {
PetscMPIInt sent,nsends;
ierr = PetscMPIIntCast(nto,&nsends);CHKERRQ(ierr);
ierr = MPI_Testall(nsends,sendreqs,&sent,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
if (sent) {
#if defined(PETSC_HAVE_MPI_IBARRIER)
ierr = MPI_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#elif defined(PETSC_HAVE_MPIX_IBARRIER)
ierr = MPIX_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#endif
ierr = PetscFree(sendreqs);CHKERRQ(ierr);
}
} else {
ierr = MPI_Test(&barrier,&done,MPI_STATUS_IGNORE);CHKERRQ(ierr);
}
}
*nfrom = nrecvs;
ierr = PetscSegBufferExtractAlloc(segrank,fromranks);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferExtractAlloc(segdata,fromdata);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segdata);CHKERRQ(ierr);
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
QMP_bool_t
QMP_is_complete_mpi (QMP_msghandle_t mh)
{
QMP_bool_t done = QMP_FALSE;
if(mh->type==MH_multiple) {
int flag, callst;
/* MPI_Status status[mh->num]; */
MPI_Status *status; QMP_alloc(status, MPI_Status, mh->num);
callst = MPI_Testall(mh->num, mh->request_array, &flag, status);
if (callst != MPI_SUCCESS) {
QMP_fprintf (stderr, "Testall return value is %d\n", callst);
QMP_FATAL("test unexpectedly failed");
}
if(flag) done = QMP_TRUE;
QMP_free(status);
} else {
int flag, callst;
MPI_Status status;
callst = MPI_Test(&mh->request, &flag, &status);
if (callst != MPI_SUCCESS) {
QMP_fprintf (stderr, "Test return value is %d\n", callst);
QMP_FATAL("test unexpectedly failed");
}
if(flag) done = QMP_TRUE;
}
return done;
}
void FixedSizeBinner::pollPending()
{
if (pendingIO.empty()) return;
std::list<FixedSizeBinnerIOData * > newPending;
for (std::list<FixedSizeBinnerIOData * >::iterator it = pendingIO.begin(); it != pendingIO.end(); ++it)
{
FixedSizeBinnerIOData * data = *it;
int flag;
MPI_Testall(3, data->reqs, &flag, data->stat);
if (flag)
{
data->cond->lockMutex();
if (*data->waiting) data->cond->broadcast();
*data->flag = true;
data->cond->unlockMutex();
delete [] data->counts;
if (copySendData)
{
if (data->keys != NULL) delete [] reinterpret_cast<char * >(data->keys);
if (data->vals != NULL) delete [] reinterpret_cast<char * >(data->vals);
}
delete data;
}
else
{
newPending.push_back(data);
}
}
pendingIO = newPending;
}
/************
* testall: tests that all requests have completed,
* if so return request array, otherwise set flag=0
*/
FC_FUNC(mpi_testall, MPI_TESTALL)
(int * count, int * array_of_requests, int *flag,
int * array_of_statuses, int * ierr)
{
*ierr = MPI_Testall(*count, array_of_requests, flag,
mpi_c_statuses(array_of_statuses));
}
inline bool test_all(
ContiguousIterator1 const first, ContiguousIterator1 const last,
ContiguousIterator2 const out, ::yampi::environment const& environment)
{
static_assert(
(YAMPI_is_same<
typename YAMPI_remove_cv<
typename std::iterator_traits<ContiguousIterator1>::value_type>::type,
::yampi::request>::value),
"Value type of ContiguousIterator1 must be the same to ::yampi::request");
static_assert(
(YAMPI_is_same<
typename YAMPI_remove_cv<
typename std::iterator_traits<ContiguousIterator2>::value_type>::type,
::yampi::status>::value),
"Value type of ContiguousIterator2 must be the same to ::yampi::status");
int flag;
int const error_code
= MPI_Testall(
last-first, reinterpret_cast<MPI_Request*>(YAMPI_addressof(*first)),
YAMPI_addressof(flag),
reinterpret_cast<MPI_Status*>(YAMPI_addressof(*out)));
return error_code == MPI_SUCCESS
? static_cast<bool>(flag)
: throw ::yampi::error(error_code, "yampi::test_all", environment);
}
/* master 进程 */
void coordinator()
{
printf("\tProcessor %d at %s begin work..\n", myid, processor_name);
MPI_Status status[MAXPROCS];
MPI_Request handle[MAXPROCS];
int recv_flag = 0;
while(1)
{
// 非阻塞接收所有从进程提交的消息
for(int i=1; i < numprocs; i++)
{
MPI_Irecv(revGenes+(i-1)*n, n, MPI_GENETYPE, i, MPI_ANY_TAG, MPI_COMM_WORLD, handle+(i-1));
}
// 循环等待非阻塞接收完成
while(!recv_flag)
{
// 测试所有接收是否完成
MPI_Testall(numprocs-1, handle, &recv_flag, status);
// 判断是否有收到DONE_TAG消息
for(int i=0; i< numprocs-1; i++)
{
if(status[i].MPI_TAG == DONE_TAG)
{
// 将最优个体保存在population[CARDINALITY]中
assign(&population[CARDINALITY],&revGenes[(status[i].MPI_SOURCE-1)*n]);
// 发送终止消息给其它从进程
for(int j=1; j < numprocs; j++)
{
if(j != status[i].MPI_SOURCE)
MPI_Send(NULL, 0, MPI_INT, j, DONE_TAG, MPI_COMM_WORLD);
}
printf("\tProcessor %d at %s exit\n", myid, processor_name);
// 设置时间和长度
mytime = MPI_Wtime() - start;
length = population[CARDINALITY].fitness;
// 输出结果
printf("\n\t***************** Results *********************\n");
printf("\t**** Time ：%lf \n", mytime);
printf("\t**** Length: %lf \n", length);
printf("\t***********************************************\n");
// 绘制图形
//draw(population[CARDINALITY].path, numOfCities);
return;
}
}
}
// 重置标志
recv_flag = 0;
// 对接收到的优良个体排序，取最优的n个发送给所有从进程
qsort(revGenes, (numprocs-1)*n, sizeof(GeneType), compare);
for(int i=0; i < n; i++)assign(&selectedGenes[i],&revGenes[i]);
for(int i=1; i < numprocs; i++)
MPI_Send(selectedGenes, n, MPI_GENETYPE, i, SEND_BETTER_TAG, MPI_COMM_WORLD);
printf("\tcurrrent shortest path is %lf\n", revGenes[0].fitness);
}
}
int main(int argc, char *argv[])
{
int provided;
MPI_Request request;
int flag;
int outcount = -1;
int indices[1] = { -1 };
MPI_Status status;
char *env;
env = getenv("MPITEST_VERBOSE");
if (env) {
if (*env != '0')
verbose = 1;
}
MPI_Init_thread(&argc, &argv, MPI_THREAD_MULTIPLE, &provided);
if (provided != MPI_THREAD_MULTIPLE) {
printf("This test requires MPI_THREAD_MULTIPLE\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
IF_VERBOSE(("Post Init ...\n"));
MPI_Grequest_start(query_fn, free_fn, cancel_fn, NULL, &request);
grequest = request; /* copy the handle */
MTest_Start_thread(do_work, &grequest);
IF_VERBOSE(("Testing ...\n"));
flag = 0;
while (!flag) {
MPI_Test(&request, &flag, &status);
}
MTest_Join_threads();
MPI_Grequest_start(query_fn, free_fn, cancel_fn, NULL, &request);
grequest = request; /* copy the handle */
MTest_Start_thread(do_work, &grequest);
IF_VERBOSE(("Testing ...\n"));
outcount = 0;
while (!outcount) {
MPI_Testsome(1, &request, &outcount, indices, &status);
}
MTest_Join_threads();
MPI_Grequest_start(query_fn, free_fn, cancel_fn, NULL, &request);
grequest = request; /* copy the handle */
MTest_Start_thread(do_work, &grequest);
IF_VERBOSE(("Testing ...\n"));
flag = 0;
while (!flag) {
MPI_Testall(1, &request, &flag, &status);
}
MTest_Join_threads();
IF_VERBOSE(("Goodbye !!!\n"));
MTest_Finalize(0);
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
int rank, size;
MPI_Win win = MPI_WIN_NULL;
int *baseptr = NULL;
int errs = 0, mpi_errno = MPI_SUCCESS;
int val1 = 0, val2 = 0, flag = 0;
MPI_Request reqs[2];
MPI_Status stats[2];
MTest_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &size);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
MPI_Win_allocate(2 * sizeof(int), sizeof(int), MPI_INFO_NULL, MPI_COMM_WORLD, &baseptr, &win);
/* Initialize window buffer */
MPI_Win_lock(MPI_LOCK_EXCLUSIVE, rank, 0, win);
baseptr[0] = 1;
baseptr[1] = 2;
MPI_Win_unlock(rank, win);
MPI_Barrier(MPI_COMM_WORLD);
/* Issue request-based get with testall. */
MPI_Win_lock_all(0, win);
MPI_Rget(&val1, 1, MPI_INT, 0, 0, 1, MPI_INT, win, &reqs[0]);
MPI_Rget(&val2, 1, MPI_INT, 0, 1, 1, MPI_INT, win, &reqs[1]);
do {
mpi_errno = MPI_Testall(2, reqs, &flag, stats);
} while (flag == 0);
/* Check get value. */
if (val1 != 1 || val2 != 2) {
printf("%d - Got val1 = %d, val2 = %d, expected 1, 2\n", rank, val1, val2);
fflush(stdout);
errs++;
}
/* Check return error code. */
if (mpi_errno != MPI_SUCCESS) {
printf("%d - Got return errno %d, expected MPI_SUCCESS(%d)\n",
rank, mpi_errno, MPI_SUCCESS);
fflush(stdout);
errs++;
}
MPI_Win_unlock_all(win);
MPI_Barrier(MPI_COMM_WORLD);
MPI_Win_free(&win);
MTest_Finalize(errs);
MPI_Finalize();
return errs != 0;
}
void mpi_testall_ (int* count, int * requests, int *flag, MPI_Status * statuses, int* ierr){
MPI_Request* reqs;
int i;
reqs = xbt_new(MPI_Request, *count);
for(i = 0; i < *count; i++) {
reqs[i] = find_request(requests[i]);
}
*ierr= MPI_Testall(*count, reqs, flag, statuses);
}
static PetscErrorCode PetscCommBuildTwoSided_Ibarrier(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscInt nto,const PetscMPIInt *toranks,const void *todata,PetscInt *nfrom,PetscMPIInt **fromranks,void *fromdata)
{
PetscErrorCode ierr;
PetscMPIInt nrecvs,tag,unitbytes,done;
PetscInt i;
char *tdata;
MPI_Request *sendreqs,barrier;
PetscSegBuffer segrank,segdata;
PetscFunctionBegin;
ierr = PetscCommGetNewTag(comm,&tag);CHKERRQ(ierr);
ierr = MPI_Type_size(dtype,&unitbytes);CHKERRQ(ierr);
tdata = (char*)todata;
ierr = PetscMalloc(nto*sizeof(MPI_Request),&sendreqs);CHKERRQ(ierr);
for (i=0; i<nto; i++) {
ierr = MPI_Issend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
ierr = PetscSegBufferCreate(sizeof(PetscMPIInt),4,&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferCreate(unitbytes,4*count,&segdata);CHKERRQ(ierr);
nrecvs = 0;
barrier = MPI_REQUEST_NULL;
for (done=0; !done; ) {
PetscMPIInt flag;
MPI_Status status;
ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag,comm,&flag,&status);CHKERRQ(ierr);
if (flag) { /* incoming message */
PetscMPIInt *recvrank;
void *buf;
ierr = PetscSegBufferGet(&segrank,1,&recvrank);CHKERRQ(ierr);
ierr = PetscSegBufferGet(&segdata,count,&buf);CHKERRQ(ierr);
*recvrank = status.MPI_SOURCE;
ierr = MPI_Recv(buf,count,dtype,status.MPI_SOURCE,tag,comm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
nrecvs++;
}
if (barrier == MPI_REQUEST_NULL) {
PetscMPIInt sent,nsends;
ierr = PetscMPIIntCast(nto,&nsends);CHKERRQ(ierr);
ierr = MPI_Testall(nsends,sendreqs,&sent,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
if (sent) {
ierr = MPI_Ibarrier(comm,&barrier);CHKERRQ(ierr);
ierr = PetscFree(sendreqs);CHKERRQ(ierr);
}
} else {
ierr = MPI_Test(&barrier,&done,MPI_STATUS_IGNORE);CHKERRQ(ierr);
}
}
*nfrom = nrecvs;
ierr = PetscSegBufferExtractAlloc(&segrank,fromranks);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferExtractAlloc(&segdata,fromdata);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segdata);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
FORT_DLL_SPEC void FORT_CALL mpi_testall_ ( MPI_Fint *v1, MPI_Fint v2[], MPI_Fint *v3, MPI_Fint v4[], MPI_Fint *ierr ){
int l3;
#ifndef HAVE_MPI_F_INIT_WORKS_WITH_C
if (MPIR_F_NeedInit){ mpirinitf_(); MPIR_F_NeedInit = 0; }
#endif
if (v4 == MPI_F_STATUSES_IGNORE) { v4 = (MPI_Fint *)MPI_STATUSES_IGNORE; }
*ierr = MPI_Testall( (int)*v1, (MPI_Request *)(v2), &l3, (MPI_Status *)v4 );
if (*ierr == MPI_SUCCESS) *v3 = MPIR_TO_FLOG(l3);
}
HYPRE_Int
hypre_MPI_Testall( HYPRE_Int count,
hypre_MPI_Request *array_of_requests,
HYPRE_Int *flag,
hypre_MPI_Status *array_of_statuses )
{
hypre_int mpi_flag;
HYPRE_Int ierr;
ierr = (HYPRE_Int) MPI_Testall((hypre_int)count, array_of_requests,
&mpi_flag, array_of_statuses);
*flag = (HYPRE_Int) mpi_flag;
return ierr;
}
JNIEXPORT jboolean JNICALL Java_mpi_Request_testAll(
JNIEnv *env, jclass jthis, jlongArray requests)
{
int count = (*env)->GetArrayLength(env, requests);
jlong* jReq;
MPI_Request *cReq;
ompi_java_getPtrArray(env, requests, &jReq, (void***)&cReq);
int flag;
int rc = MPI_Testall(count, cReq, &flag, MPI_STATUSES_IGNORE);
ompi_java_exceptionCheck(env, rc);
ompi_java_releasePtrArray(env, requests, jReq, (void**)cReq);
return flag ? JNI_TRUE : JNI_FALSE;
}
void FixedSizeBinner::poll(int & finishedWorkers,
bool * const workerDone,
bool * const recvingCount,
int * const counts,
int ** keyRecv,
int ** valRecv,
MPI_Request * recvReqs)
{
pollSends();
int flag;
MPI_Status stat[2];
for (int i = 0; i < commSize; ++i)
{
if (workerDone[i]) continue;
if (recvingCount[i])
{
MPI_Test(recvReqs + i * 2, &flag, stat);
if (flag)
{
// printf("%2d - recv'd counts %d and %d from %d.\n", commRank, counts[i * 2 + 0], counts[i * 2 + 1], i); fflush(stdout);
recvingCount[i] = false;
if (counts[i * 2] == 0)
{
workerDone[i] = true;
++finishedWorkers;
// printf("%2d - recv'd 'finished' command from %d, now have %d finished workers.\n", commRank, i, finishedWorkers); fflush(stdout);
}
else
{
keyRecv[i] = new int[counts[i * 2 + 0] / sizeof(int)];
valRecv[i] = new int[counts[i * 2 + 1] / sizeof(int)];
MPI_Irecv(keyRecv[i], counts[i * 2 + 0], MPI_CHAR, i, 0, MPI_COMM_WORLD, recvReqs + i * 2 + 0);
MPI_Irecv(valRecv[i], counts[i * 2 + 1], MPI_CHAR, i, 0, MPI_COMM_WORLD, recvReqs + i * 2 + 1);
}
}
}
else
{
MPI_Testall(2, recvReqs + i * 2, &flag, stat);
if (flag)
{
privateAdd(keyRecv[i], valRecv[i], counts[i * 2 + 0], counts[i * 2 + 1]);
recvingCount[i] = true;
MPI_Irecv(counts + i * 2, 2, MPI_INT, i, 0, MPI_COMM_WORLD, recvReqs + i * 2);
delete [] keyRecv[i];
delete [] valRecv[i];
}
}
}
}
JNIEXPORT jobjectArray JNICALL Java_mpi_Request_testAllStatus(
JNIEnv *env, jclass clazz, jlongArray requests)
{
int count = (*env)->GetArrayLength(env, requests);
jlong* jReq;
MPI_Request *cReq;
ompi_java_getPtrArray(env, requests, &jReq, (void***)&cReq);
MPI_Status *statuses = (MPI_Status*)calloc(count, sizeof(MPI_Status));
int flag;
int rc = MPI_Testall(count, cReq, &flag, statuses);
ompi_java_exceptionCheck(env, rc);
ompi_java_releasePtrArray(env, requests, jReq, (void**)cReq);
jobjectArray jStatuses = flag ? newStatuses(env, statuses, count) : NULL;
free(statuses);
return jStatuses;
}
static inline
int test_comm_status(cluster_t *cl, val_t *Wstruct)
{
int cl_begin = cl->begin;
int cl_end = cl->end;
int bl_begin = cl->bl_begin;
int bl_end = cl->bl_end;
rrr_t *RRR = cl->RRR;
comm_t *comm = cl->messages;
int num_messages = comm->num_messages;
MPI_Request *requests = comm->requests;
MPI_Status *stats = comm->stats;
double *restrict W = Wstruct->W;
double *restrict Werr = Wstruct->Werr;
double *restrict Wgap = Wstruct->Wgap;
double *restrict Wshifted = Wstruct->Wshifted;
int status, k, communication_done;
double sigma;
/* Test if communication complete */
status = MPI_Testall(num_messages, requests,
&communication_done, stats);
assert(status == MPI_SUCCESS);
if (communication_done == true) {
cl->wait_until_refined = false;
sigma = RRR->L[bl_end-bl_begin];
for (k=cl_begin; k<cl_end; k++) {
W[k] = Wshifted[k] + sigma;
Wgap[k] = fmax(0, Wshifted[k+1]-Werr[k+1]
- (Wshifted[k]-Werr[k]));
}
W[cl_end] = Wshifted[cl_end] + sigma;
free(comm);
free(requests);
free(stats);
status = COMM_COMPLETE;
} else {
status = COMM_INCOMPLETE;
}
return(status);
} /* test_comm_status */
int
main (int argc, char **argv)
{
int nprocs = -1;
int rank = -1;
MPI_Comm comm = MPI_COMM_WORLD;
char processor_name[128];
int namelen = 128;
int buf[BUF_SIZE * 2];
int i, j, k, index, outcount, flag;
int indices[2];
MPI_Request aReq[2];
MPI_Status aStatus[2];
/* init */
MPI_Init (&argc, &argv);
MPI_Comm_size (comm, &nprocs);
MPI_Comm_rank (comm, &rank);
MPI_Get_processor_name (processor_name, &namelen);
printf ("(%d) is alive on %s\n", rank, processor_name);
fflush (stdout);
if (rank == 0) {
/* set up persistent sends... */
MPI_Send_init (&buf[0], BUF_SIZE, MPI_INT, 1, 0, comm, &aReq[0]);
MPI_Send_init (&buf[BUF_SIZE], BUF_SIZE, MPI_INT, 1, 1, comm, &aReq[1]);
/* initialize the send buffers */
for (i = 0; i < BUF_SIZE; i++) {
buf[i] = i;
buf[BUF_SIZE + i] = BUF_SIZE - 1 - i;
}
}
for (k = 0; k < 4; k++) {
if (rank == 1) {
/* zero out the receive buffers */
bzero (buf, sizeof(int) * BUF_SIZE * 2);
}
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) {
/* start the persistent sends... */
if (k % 2) {
MPI_Startall (2, &aReq[0]);
}
else {
for (j = 0; j < 2; j++) {
MPI_Start (&aReq[j]);
}
}
/* complete the sends */
if (k < 2) {
/* use MPI_Test */
for (j = 0; j < 2; j++) {
flag = 0;
while (!flag) {
MPI_Test (&aReq[j], &flag, &aStatus[j]);
}
}
}
else {
/* use MPI_Testall */
flag = 0;
while (!flag) {
MPI_Testall (2, aReq, &flag, aStatus);
}
}
}
else if (rank == 1) {
/* set up receives for all of the sends */
for (j = 0; j < 2; j++) {
MPI_Irecv (&buf[j * BUF_SIZE], BUF_SIZE,
MPI_INT, 0, j, comm, &aReq[j]);
}
/* complete all of the receives... */
MPI_Waitall (2, aReq, aStatus);
}
}
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) {
/* free the persistent requests */
for (i = 0 ; i < 2; i++) {
MPI_Request_free (&aReq[i]);
}
}
MPI_Finalize ();
printf ("(%d) Finished normally\n", rank);
}
/* Sets error_code to MPI_SUCCESS if successful, or creates an error code
* in the case of error.
*/
static void ADIOI_LUSTRE_W_Exchange_data(ADIO_File fd, const void *buf,
char *write_buf,
ADIOI_Flatlist_node *flat_buf,
ADIO_Offset *offset_list,
ADIO_Offset *len_list, int *send_size,
int *recv_size, ADIO_Offset off,
int size, int *count,
int *start_pos,
int *sent_to_proc, int nprocs,
int myrank, int buftype_is_contig,
int contig_access_count,
int *striping_info,
ADIOI_Access *others_req,
int *send_buf_idx,
int *curr_to_proc, int *done_to_proc,
int *hole, int iter,
MPI_Aint buftype_extent,
int *buf_idx,
ADIO_Offset **srt_off, int **srt_len, int *srt_num,
int *error_code)
{
int i, j, nprocs_recv, nprocs_send, err;
char **send_buf = NULL;
MPI_Request *requests, *send_req;
MPI_Datatype *recv_types;
MPI_Status *statuses, status;
int sum_recv;
int data_sieving = *hole;
static char myname[] = "ADIOI_W_EXCHANGE_DATA";
/* create derived datatypes for recv */
nprocs_recv = 0;
for (i = 0; i < nprocs; i++)
if (recv_size[i])
nprocs_recv++;
recv_types = (MPI_Datatype *) ADIOI_Malloc((nprocs_recv + 1) *
sizeof(MPI_Datatype));
/* +1 to avoid a 0-size malloc */
j = 0;
for (i = 0; i < nprocs; i++) {
if (recv_size[i]) {
ADIOI_Type_create_hindexed_x(count[i],
&(others_req[i].lens[start_pos[i]]),
&(others_req[i].mem_ptrs[start_pos[i]]),
MPI_BYTE, recv_types + j);
/* absolute displacements; use MPI_BOTTOM in recv */
MPI_Type_commit(recv_types + j);
j++;
}
}
/* To avoid a read-modify-write,
* check if there are holes in the data to be written.
* For this, merge the (sorted) offset lists others_req using a heap-merge.
*/
*srt_num = 0;
for (i = 0; i < nprocs; i++)
*srt_num += count[i];
if (*srt_off)
*srt_off = (ADIO_Offset *) ADIOI_Realloc(*srt_off, (*srt_num + 1) * sizeof(ADIO_Offset));
else
*srt_off = (ADIO_Offset *) ADIOI_Malloc((*srt_num + 1) * sizeof(ADIO_Offset));
if (*srt_len)
*srt_len = (int *) ADIOI_Realloc(*srt_len, (*srt_num + 1) * sizeof(int));
else
*srt_len = (int *) ADIOI_Malloc((*srt_num + 1) * sizeof(int));
/* +1 to avoid a 0-size malloc */
ADIOI_Heap_merge(others_req, count, *srt_off, *srt_len, start_pos,
nprocs, nprocs_recv, *srt_num);
/* check if there are any holes */
*hole = 0;
for (i = 0; i < *srt_num - 1; i++) {
if ((*srt_off)[i] + (*srt_len)[i] < (*srt_off)[i + 1]) {
*hole = 1;
break;
}
}
/* In some cases (see John Bent ROMIO REQ # 835), an odd interaction
* between aggregation, nominally contiguous regions, and cb_buffer_size
* should be handled with a read-modify-write (otherwise we will write out
* more data than we receive from everyone else (inclusive), so override
* hole detection
*/
if (*hole == 0) {
sum_recv = 0;
for (i = 0; i < nprocs; i++)
sum_recv += recv_size[i];
if (size > sum_recv)
*hole = 1;
}
/* check the hint for data sieving */
if (data_sieving == ADIOI_HINT_ENABLE && nprocs_recv && *hole) {
ADIO_ReadContig(fd, write_buf, size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, off, &status, &err);
// --BEGIN ERROR HANDLING--
if (err != MPI_SUCCESS) {
*error_code = MPIO_Err_create_code(err,
MPIR_ERR_RECOVERABLE,
myname, __LINE__,
MPI_ERR_IO,
"**ioRMWrdwr", 0);
ADIOI_Free(recv_types);
return;
}
// --END ERROR HANDLING--
}
nprocs_send = 0;
for (i = 0; i < nprocs; i++)
if (send_size[i])
nprocs_send++;
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
requests = (MPI_Request *) ADIOI_Malloc((nprocs_send + 1) *
sizeof(MPI_Request));
send_req = requests;
} else {
requests = (MPI_Request *) ADIOI_Malloc((nprocs_send + nprocs_recv + 1)*
sizeof(MPI_Request));
/* +1 to avoid a 0-size malloc */
/* post receives */
j = 0;
for (i = 0; i < nprocs; i++) {
if (recv_size[i]) {
MPI_Irecv(MPI_BOTTOM, 1, recv_types[j], i,
myrank + i + 100 * iter, fd->comm, requests + j);
j++;
}
}
send_req = requests + nprocs_recv;
}
/* post sends.
* if buftype_is_contig, data can be directly sent from
* user buf at location given by buf_idx. else use send_buf.
*/
if (buftype_is_contig) {
j = 0;
for (i = 0; i < nprocs; i++)
if (send_size[i]) {
ADIOI_Assert(buf_idx[i] != -1);
MPI_Isend(((char *) buf) + buf_idx[i], send_size[i],
MPI_BYTE, i, myrank + i + 100 * iter, fd->comm,
send_req + j);
j++;
}
} else
if (nprocs_send) {
/* buftype is not contig */
send_buf = (char **) ADIOI_Malloc(nprocs * sizeof(char *));
for (i = 0; i < nprocs; i++)
if (send_size[i])
send_buf[i] = (char *) ADIOI_Malloc(send_size[i]);
ADIOI_LUSTRE_Fill_send_buffer(fd, buf, flat_buf, send_buf, offset_list,
len_list, send_size, send_req,
sent_to_proc, nprocs, myrank,
contig_access_count, striping_info,
send_buf_idx, curr_to_proc, done_to_proc,
iter, buftype_extent);
/* the send is done in ADIOI_Fill_send_buffer */
}
/* bug fix from Wei-keng Liao and Kenin Coloma */
if (fd->atomicity) {
j = 0;
for (i = 0; i < nprocs; i++) {
MPI_Status wkl_status;
if (recv_size[i]) {
MPI_Recv(MPI_BOTTOM, 1, recv_types[j], i,
myrank + i + 100 * iter, fd->comm, &wkl_status);
j++;
}
}
}
for (i = 0; i < nprocs_recv; i++)
MPI_Type_free(recv_types + i);
ADIOI_Free(recv_types);
/* bug fix from Wei-keng Liao and Kenin Coloma */
/* +1 to avoid a 0-size malloc */
if (fd->atomicity) {
statuses = (MPI_Status *) ADIOI_Malloc((nprocs_send + 1) *
sizeof(MPI_Status));
} else {
statuses = (MPI_Status *) ADIOI_Malloc((nprocs_send + nprocs_recv + 1) *
sizeof(MPI_Status));
}
#ifdef NEEDS_MPI_TEST
i = 0;
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
while (!i)
MPI_Testall(nprocs_send, send_req, &i, statuses);
} else {
while (!i)
MPI_Testall(nprocs_send + nprocs_recv, requests, &i, statuses);
}
#else
/* bug fix from Wei-keng Liao and Kenin Coloma */
if (fd->atomicity)
MPI_Waitall(nprocs_send, send_req, statuses);
else
MPI_Waitall(nprocs_send + nprocs_recv, requests, statuses);
#endif
ADIOI_Free(statuses);
ADIOI_Free(requests);
if (!buftype_is_contig && nprocs_send) {
for (i = 0; i < nprocs; i++)
if (send_size[i])
ADIOI_Free(send_buf[i]);
ADIOI_Free(send_buf);
}
}
static PetscErrorCode PetscCommBuildTwoSidedFReq_Ibarrier(MPI_Comm comm,PetscMPIInt count,MPI_Datatype dtype,PetscMPIInt nto,const PetscMPIInt *toranks,const void *todata,
PetscMPIInt *nfrom,PetscMPIInt **fromranks,void *fromdata,PetscMPIInt ntags,MPI_Request **toreqs,MPI_Request **fromreqs,
PetscErrorCode (*send)(MPI_Comm,const PetscMPIInt[],PetscMPIInt,PetscMPIInt,void*,MPI_Request[],void*),
PetscErrorCode (*recv)(MPI_Comm,const PetscMPIInt[],PetscMPIInt,void*,MPI_Request[],void*),void *ctx)
{
PetscErrorCode ierr;
PetscMPIInt nrecvs,tag,*tags,done,i;
MPI_Aint lb,unitbytes;
char *tdata;
MPI_Request *sendreqs,*usendreqs,*req,barrier;
PetscSegBuffer segrank,segdata,segreq;
PetscBool barrier_started;
PetscFunctionBegin;
ierr = PetscCommDuplicate(comm,&comm,&tag);CHKERRQ(ierr);
ierr = PetscMalloc1(ntags,&tags);CHKERRQ(ierr);
for (i=0; i<ntags; i++) {
ierr = PetscCommGetNewTag(comm,&tags[i]);CHKERRQ(ierr);
}
ierr = MPI_Type_get_extent(dtype,&lb,&unitbytes);CHKERRQ(ierr);
if (lb != 0) SETERRQ1(comm,PETSC_ERR_SUP,"Datatype with nonzero lower bound %ld\n",(long)lb);
tdata = (char*)todata;
ierr = PetscMalloc1(nto,&sendreqs);CHKERRQ(ierr);
ierr = PetscMalloc1(nto*ntags,&usendreqs);CHKERRQ(ierr);
/* Post synchronous sends */
for (i=0; i<nto; i++) {
ierr = MPI_Issend((void*)(tdata+count*unitbytes*i),count,dtype,toranks[i],tag,comm,sendreqs+i);CHKERRQ(ierr);
}
/* Post actual payloads. These are typically larger messages. Hopefully sending these later does not slow down the
* synchronous messages above. */
for (i=0; i<nto; i++) {
PetscMPIInt k;
for (k=0; k<ntags; k++) usendreqs[i*ntags+k] = MPI_REQUEST_NULL;
ierr = (*send)(comm,tags,i,toranks[i],tdata+count*unitbytes*i,usendreqs+i*ntags,ctx);CHKERRQ(ierr);
}
ierr = PetscSegBufferCreate(sizeof(PetscMPIInt),4,&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferCreate(unitbytes,4*count,&segdata);CHKERRQ(ierr);
ierr = PetscSegBufferCreate(sizeof(MPI_Request),4,&segreq);CHKERRQ(ierr);
nrecvs = 0;
barrier = MPI_REQUEST_NULL;
/* MPICH-3.2 sometimes does not create a request in some "optimized" cases. This is arguably a standard violation,
* but we need to work around it. */
barrier_started = PETSC_FALSE;
for (done=0; !done; ) {
PetscMPIInt flag;
MPI_Status status;
ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag,comm,&flag,&status);CHKERRQ(ierr);
if (flag) { /* incoming message */
PetscMPIInt *recvrank,k;
void *buf;
ierr = PetscSegBufferGet(segrank,1,&recvrank);CHKERRQ(ierr);
ierr = PetscSegBufferGet(segdata,count,&buf);CHKERRQ(ierr);
*recvrank = status.MPI_SOURCE;
ierr = MPI_Recv(buf,count,dtype,status.MPI_SOURCE,tag,comm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
ierr = PetscSegBufferGet(segreq,ntags,&req);CHKERRQ(ierr);
for (k=0; k<ntags; k++) req[k] = MPI_REQUEST_NULL;
ierr = (*recv)(comm,tags,status.MPI_SOURCE,buf,req,ctx);CHKERRQ(ierr);
nrecvs++;
}
if (!barrier_started) {
PetscMPIInt sent,nsends;
ierr = PetscMPIIntCast(nto,&nsends);CHKERRQ(ierr);
ierr = MPI_Testall(nsends,sendreqs,&sent,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
if (sent) {
#if defined(PETSC_HAVE_MPI_IBARRIER)
ierr = MPI_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#elif defined(PETSC_HAVE_MPIX_IBARRIER)
ierr = MPIX_Ibarrier(comm,&barrier);CHKERRQ(ierr);
#endif
barrier_started = PETSC_TRUE;
}
} else {
ierr = MPI_Test(&barrier,&done,MPI_STATUS_IGNORE);CHKERRQ(ierr);
}
}
*nfrom = nrecvs;
ierr = PetscSegBufferExtractAlloc(segrank,fromranks);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segrank);CHKERRQ(ierr);
ierr = PetscSegBufferExtractAlloc(segdata,fromdata);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segdata);CHKERRQ(ierr);
*toreqs = usendreqs;
ierr = PetscSegBufferExtractAlloc(segreq,fromreqs);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&segreq);CHKERRQ(ierr);
ierr = PetscFree(sendreqs);CHKERRQ(ierr);
ierr = PetscFree(tags);CHKERRQ(ierr);
ierr = PetscCommDestroy(&comm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static void complete_something_somehow(unsigned int rndnum, int numreqs, MPI_Request reqs[], int *outcount, int indices[])
{
int i, idx, flag;
#define COMPLETION_CASES (8)
switch (rand_range(rndnum, 0, COMPLETION_CASES)) {
case 0:
MPI_Waitall(numreqs, reqs, MPI_STATUSES_IGNORE);
*outcount = numreqs;
for (i = 0; i < numreqs; ++i) {
indices[i] = i;
}
break;
case 1:
MPI_Testsome(numreqs, reqs, outcount, indices, MPI_STATUS_IGNORE);
if (*outcount == MPI_UNDEFINED) {
*outcount = 0;
}
break;
case 2:
MPI_Waitsome(numreqs, reqs, outcount, indices, MPI_STATUS_IGNORE);
if (*outcount == MPI_UNDEFINED) {
*outcount = 0;
}
break;
case 3:
MPI_Waitany(numreqs, reqs, &idx, MPI_STATUS_IGNORE);
if (idx == MPI_UNDEFINED) {
*outcount = 0;
}
else {
*outcount = 1;
indices[0] = idx;
}
break;
case 4:
MPI_Testany(numreqs, reqs, &idx, &flag, MPI_STATUS_IGNORE);
if (idx == MPI_UNDEFINED) {
*outcount = 0;
}
else {
*outcount = 1;
indices[0] = idx;
}
break;
case 5:
MPI_Testall(numreqs, reqs, &flag, MPI_STATUSES_IGNORE);
if (flag) {
*outcount = numreqs;
for (i = 0; i < numreqs; ++i) {
indices[i] = i;
}
}
else {
*outcount = 0;
}
break;
case 6:
/* select a new random index and wait on it */
rndnum = gen_prn(rndnum);
idx = rand_range(rndnum, 0, numreqs);
MPI_Wait(&reqs[idx], MPI_STATUS_IGNORE);
*outcount = 1;
indices[0] = idx;
break;
case 7:
/* select a new random index and wait on it */
rndnum = gen_prn(rndnum);
idx = rand_range(rndnum, 0, numreqs);
MPI_Test(&reqs[idx], &flag, MPI_STATUS_IGNORE);
*outcount = (flag ? 1 : 0);
indices[0] = idx;
break;
default:
assert(0);
break;
}
#undef COMPLETION_CASES
}
static inline
int communicate_refined_eigvals
(cluster_t *cl, proc_t *procinfo, int tid, val_t *Wstruct, rrr_t *RRR)
{
int cl_begin = cl->begin;
int cl_end = cl->end;
int bl_begin = cl->bl_begin;
int bl_end = cl->bl_end;
int proc_W_begin = cl->proc_W_begin;
int proc_W_end = cl->proc_W_end;
int left_pid = cl->left_pid;
int right_pid = cl->right_pid;
int pid = procinfo->pid;
double *restrict W = Wstruct->W;
double *restrict Werr = Wstruct->Werr;
double *restrict Wgap = Wstruct->Wgap;
double *restrict Wshifted = Wstruct->Wshifted;
int *restrict iproc = Wstruct->iproc;
int my_begin = imax(cl_begin, proc_W_begin);
int my_end = imin(cl_end, proc_W_end);
if (pid == left_pid ) my_begin = cl_begin;
if (pid == right_pid) my_end = cl_end;
int my_size = my_end - my_begin + 1;
int i, k;
int num_messages = 0;
for (i=left_pid; i<=right_pid; i++) {
for (k=cl_begin; k<=cl_end; k++) {
if (iproc[k] == i) {
num_messages += 4;
break;
}
}
}
MPI_Request *requests=(MPI_Request*)malloc(num_messages*sizeof(MPI_Request));
MPI_Status *stats = (MPI_Status*)malloc(num_messages*sizeof(MPI_Status));
int p;
int i_msg = 0;
int other_begin, other_end, other_size;
for (p=left_pid; p<=right_pid; p++) {
bool proc_involved = false;
for (k=cl_begin; k<=cl_end; k++) {
if (iproc[k] == p) {
proc_involved = true;
break;
}
}
int u;
if (p != pid && proc_involved == true) {
/* send message to process p (non-blocking) */
MPI_Isend(&Wshifted[my_begin], my_size, MPI_DOUBLE, p,
my_begin, procinfo->comm, &requests[4*i_msg]);
MPI_Isend(&Werr[my_begin], my_size, MPI_DOUBLE, p,
my_begin, procinfo->comm, &requests[4*i_msg+1]);
/* Find eigenvalues in of process p */
other_size = 0;
for (k=cl_begin; k<=cl_end; k++) {
if (other_size == 0 && iproc[k] == p) {
other_begin = k;
other_end = k;
other_size++;
u = k+1;
while (u <=cl_end && iproc[u] == p) {
other_end++;
other_size++;
u++;
}
}
}
if (p == left_pid) {
other_begin = cl_begin;
u = cl_begin;
while (iproc[u] == -1) {
other_size++;
u++;
}
}
if (p == right_pid) {
other_end = cl_end;
u = cl_end;
while (iproc[u] == -1) {
other_size++;
u--;
}
}
/* receive message from process p (non-blocking) */
MPI_Irecv(&Wshifted[other_begin], other_size, MPI_DOUBLE, p,
other_begin, procinfo->comm, &requests[4*i_msg+2]);
MPI_Irecv(&Werr[other_begin], other_size, MPI_DOUBLE, p,
other_begin, procinfo->comm, &requests[4*i_msg+3]);
i_msg++;
}
} /* end for p */
num_messages = 4*i_msg; /* messages actually send */
int communication_done;
int status = MPI_Testall(num_messages, requests, &communication_done, stats);
assert(status == MPI_SUCCESS);
if (communication_done == true) {
double sigma = RRR->L[bl_end-bl_begin];
for (k=cl_begin; k<cl_end; k++) {
W[k] = Wshifted[k] + sigma;
Wgap[k] = fmax(0, Wshifted[k+1]-Werr[k+1]
- (Wshifted[k]-Werr[k]));
}
W[cl_end] = Wshifted[cl_end] + sigma;
free(requests);
free(stats);
status = COMM_COMPLETE;
} else {
comm_t *comm = (comm_t*)malloc(sizeof(comm_t));
assert(comm != NULL);
comm->num_messages = num_messages;
comm->requests = requests;
comm->stats = stats;
cl->wait_until_refined = true;
cl->messages = comm;
status = COMM_INCOMPLETE;
}
return status;
} /* end communicate_refined_eigvals */
int main(int argc, char **argv)
{
int errs = 0;
MPI_Status status, *status_array = 0;
int count = 0, flag, idx, rc, errlen, *indices=0, outcnt;
MPI_Request *reqs = 0;
char errmsg[MPI_MAX_ERROR_STRING];
MTest_Init(&argc, &argv);
MPI_Comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN );
rc = MPI_Testall( count, reqs, &flag, status_array );
if (rc != MPI_SUCCESS) {
MPI_Error_string( rc, errmsg, &errlen );
printf( "MPI_Testall returned failure: %s\n", errmsg );
errs ++;
}
else if (!flag) {
printf( "MPI_Testall( 0, ... ) did not return a true flag\n") ;
errs++;
}
rc = MPI_Waitall( count, reqs, status_array );
if (rc != MPI_SUCCESS) {
MPI_Error_string( rc, errmsg, &errlen );
printf( "MPI_Waitall returned failure: %s\n", errmsg );
errs ++;
}
rc = MPI_Testany( count, reqs, &idx, &flag, &status );
if (rc != MPI_SUCCESS) {
MPI_Error_string( rc, errmsg, &errlen );
printf( "MPI_Testany returned failure: %s\n", errmsg );
errs ++;
}
else if (!flag) {
printf( "MPI_Testany( 0, ... ) did not return a true flag\n") ;
errs++;
}
rc = MPI_Waitany( count, reqs, &idx, &status );
if (rc != MPI_SUCCESS) {
MPI_Error_string( rc, errmsg, &errlen );
printf( "MPI_Waitany returned failure: %s\n", errmsg );
errs ++;
}
rc = MPI_Testsome( count, reqs, &outcnt, indices, status_array );
if (rc != MPI_SUCCESS) {
MPI_Error_string( rc, errmsg, &errlen );
printf( "MPI_Testsome returned failure: %s\n", errmsg );
errs ++;
}
rc = MPI_Waitsome( count, reqs, &outcnt, indices, status_array );
if (rc != MPI_SUCCESS) {
MPI_Error_string( rc, errmsg, &errlen );
printf( "MPI_Waitsome returned failure: %s\n", errmsg );
errs ++;
}
MTest_Finalize( errs );
MPI_Finalize();
return 0;
}
static void ADIOI_R_Exchange_data(ADIO_File fd, void *buf, ADIOI_Flatlist_node
*flat_buf, ADIO_Offset *offset_list, ADIO_Offset
*len_list, int *send_size, int *recv_size,
int *count, int *start_pos, int *partial_send,
int *recd_from_proc, int nprocs,
int myrank, int
buftype_is_contig, int contig_access_count,
ADIO_Offset min_st_offset, ADIO_Offset fd_size,
ADIO_Offset *fd_start, ADIO_Offset *fd_end,
ADIOI_Access *others_req,
int iter, MPI_Aint buftype_extent, int *buf_idx)
{
int i, j, k=0, tmp=0, nprocs_recv, nprocs_send;
char **recv_buf = NULL;
MPI_Request *requests;
MPI_Datatype send_type;
MPI_Status *statuses;
/* exchange send_size info so that each process knows how much to
receive from whom and how much memory to allocate. */
MPI_Alltoall(send_size, 1, MPI_INT, recv_size, 1, MPI_INT, fd->comm);
nprocs_recv = 0;
for (i=0; i < nprocs; i++) if (recv_size[i]) nprocs_recv++;
nprocs_send = 0;
for (i=0; i<nprocs; i++) if (send_size[i]) nprocs_send++;
requests = (MPI_Request *)
ADIOI_Malloc((nprocs_send+nprocs_recv+1)*sizeof(MPI_Request));
/* +1 to avoid a 0-size malloc */
/* post recvs. if buftype_is_contig, data can be directly recd. into
user buf at location given by buf_idx. else use recv_buf. */
#ifdef AGGREGATION_PROFILE
MPE_Log_event (5032, 0, NULL);
#endif
if (buftype_is_contig) {
j = 0;
for (i=0; i < nprocs; i++)
if (recv_size[i]) {
MPI_Irecv(((char *) buf) + buf_idx[i], recv_size[i],
MPI_BYTE, i, myrank+i+100*iter, fd->comm, requests+j);
j++;
buf_idx[i] += recv_size[i];
}
}
else {
/* allocate memory for recv_buf and post receives */
recv_buf = (char **) ADIOI_Malloc(nprocs * sizeof(char*));
for (i=0; i < nprocs; i++)
if (recv_size[i]) recv_buf[i] =
(char *) ADIOI_Malloc(recv_size[i]);
j = 0;
for (i=0; i < nprocs; i++)
if (recv_size[i]) {
MPI_Irecv(recv_buf[i], recv_size[i], MPI_BYTE, i,
myrank+i+100*iter, fd->comm, requests+j);
j++;
#ifdef RDCOLL_DEBUG
DBG_FPRINTF(stderr, "node %d, recv_size %d, tag %d \n",
myrank, recv_size[i], myrank+i+100*iter);
#endif
}
}
/* create derived datatypes and send data */
j = 0;
for (i=0; i<nprocs; i++) {
if (send_size[i]) {
/* take care if the last off-len pair is a partial send */
if (partial_send[i]) {
k = start_pos[i] + count[i] - 1;
tmp = others_req[i].lens[k];
others_req[i].lens[k] = partial_send[i];
}
ADIOI_Type_create_hindexed_x(count[i],
&(others_req[i].lens[start_pos[i]]),
&(others_req[i].mem_ptrs[start_pos[i]]),
MPI_BYTE, &send_type);
/* absolute displacement; use MPI_BOTTOM in send */
MPI_Type_commit(&send_type);
MPI_Isend(MPI_BOTTOM, 1, send_type, i, myrank+i+100*iter,
fd->comm, requests+nprocs_recv+j);
MPI_Type_free(&send_type);
if (partial_send[i]) others_req[i].lens[k] = tmp;
j++;
}
}
statuses = (MPI_Status *) ADIOI_Malloc((nprocs_send+nprocs_recv+1) * \
sizeof(MPI_Status));
/* +1 to avoid a 0-size malloc */
/* wait on the receives */
if (nprocs_recv) {
#ifdef NEEDS_MPI_TEST
j = 0;
while (!j) MPI_Testall(nprocs_recv, requests, &j, statuses);
#else
MPI_Waitall(nprocs_recv, requests, statuses);
#endif
/* if noncontiguous, to the copies from the recv buffers */
if (!buftype_is_contig)
ADIOI_Fill_user_buffer(fd, buf, flat_buf, recv_buf,
offset_list, len_list, (unsigned*)recv_size,
requests, statuses, recd_from_proc,
nprocs, contig_access_count,
min_st_offset, fd_size, fd_start, fd_end,
buftype_extent);
}
/* wait on the sends*/
MPI_Waitall(nprocs_send, requests+nprocs_recv, statuses+nprocs_recv);
ADIOI_Free(statuses);
ADIOI_Free(requests);
if (!buftype_is_contig) {
for (i=0; i < nprocs; i++)
if (recv_size[i]) ADIOI_Free(recv_buf[i]);
ADIOI_Free(recv_buf);
}
#ifdef AGGREGATION_PROFILE
MPE_Log_event (5033, 0, NULL);
#endif
}
static int ADIOI_GEN_irc_poll_fn(void *extra_state, MPI_Status *status)
{
ADIOI_NBC_Request *nbc_req;
ADIOI_GEN_IreadStridedColl_vars *rsc_vars = NULL;
ADIOI_Icalc_others_req_vars *cor_vars = NULL;
ADIOI_Iread_and_exch_vars *rae_vars = NULL;
ADIOI_R_Iexchange_data_vars *red_vars = NULL;
int errcode = MPI_SUCCESS;
int flag;
nbc_req = (ADIOI_NBC_Request *)extra_state;
switch (nbc_req->data.rd.state) {
case ADIOI_IRC_STATE_GEN_IREADSTRIDEDCOLL:
rsc_vars = nbc_req->data.rd.rsc_vars;
errcode = MPI_Testall(2, rsc_vars->req_offset, &flag,
MPI_STATUSES_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
ADIOI_GEN_IreadStridedColl_inter(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_GEN_IREADSTRIDEDCOLL_INDIO:
rsc_vars = nbc_req->data.rd.rsc_vars;
errcode = MPI_Test(&rsc_vars->req_ind_io, &flag, MPI_STATUS_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
/* call the last function */
ADIOI_GEN_IreadStridedColl_fini(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_ICALC_OTHERS_REQ:
cor_vars = nbc_req->cor_vars;
errcode = MPI_Test(&cor_vars->req1, &flag, MPI_STATUS_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
ADIOI_Icalc_others_req_main(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_ICALC_OTHERS_REQ_MAIN:
cor_vars = nbc_req->cor_vars;
if (cor_vars->num_req2) {
errcode = MPI_Testall(cor_vars->num_req2, cor_vars->req2,
&flag, MPI_STATUSES_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
ADIOI_Icalc_others_req_fini(nbc_req, &errcode);
}
} else {
ADIOI_Icalc_others_req_fini(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_IREAD_AND_EXCH:
rae_vars = nbc_req->data.rd.rae_vars;
errcode = MPI_Test(&rae_vars->req1, &flag, MPI_STATUS_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
rae_vars->m = 0;
ADIOI_Iread_and_exch_l1_begin(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_IREAD_AND_EXCH_L1_BEGIN:
rae_vars = nbc_req->data.rd.rae_vars;
errcode = MPI_Test(&rae_vars->req2, &flag, MPI_STATUS_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
ADIOI_R_Iexchange_data(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_R_IEXCHANGE_DATA:
red_vars = nbc_req->data.rd.red_vars;
errcode = MPI_Test(&red_vars->req1, &flag, MPI_STATUS_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
ADIOI_R_Iexchange_data_recv(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_R_IEXCHANGE_DATA_RECV:
red_vars = nbc_req->data.rd.red_vars;
errcode = MPI_Testall(red_vars->nprocs_recv, red_vars->req2, &flag,
MPI_STATUSES_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
ADIOI_R_Iexchange_data_fill(nbc_req, &errcode);
}
break;
case ADIOI_IRC_STATE_R_IEXCHANGE_DATA_FILL:
red_vars = nbc_req->data.rd.red_vars;
errcode = MPI_Testall(red_vars->nprocs_send,
red_vars->req2 + red_vars->nprocs_recv,
&flag, MPI_STATUSES_IGNORE);
if (errcode == MPI_SUCCESS && flag) {
ADIOI_R_Iexchange_data_fini(nbc_req, &errcode);
}
break;
default:
break;
}
/* --BEGIN ERROR HANDLING-- */
if (errcode != MPI_SUCCESS) {
errcode = MPIO_Err_create_code(MPI_SUCCESS,
MPIR_ERR_RECOVERABLE,
"ADIOI_GEN_irc_poll_fn", __LINE__,
MPI_ERR_IO, "**mpi_grequest_complete",
0);
}
/* --END ERROR HANDLING-- */
return errcode;
}
int
main (int argc, char **argv)
{
int nprocs = -1;
int rank = -1;
MPI_Comm comm = MPI_COMM_WORLD;
char processor_name[128];
int namelen = 128;
int bbuf[(BUF_SIZE + MPI_BSEND_OVERHEAD) * 2 * NUM_BSEND_TYPES];
int buf[BUF_SIZE * 2 * NUM_SEND_TYPES];
int i, j, k, at_size, send_t_number, index, outcount, total, flag;
int num_errors, error_count, indices[2 * NUM_SEND_TYPES];
MPI_Request aReq[2 * NUM_SEND_TYPES];
MPI_Status aStatus[2 * NUM_SEND_TYPES];
/* init */
MPI_Init (&argc, &argv);
MPI_Comm_size (comm, &nprocs);
MPI_Comm_rank (comm, &rank);
MPI_Get_processor_name (processor_name, &namelen);
printf ("(%d) is alive on %s\n", rank, processor_name);
fflush (stdout);
MPI_Buffer_attach (bbuf, sizeof(int) *
(BUF_SIZE + MPI_BSEND_OVERHEAD) * 2 * NUM_BSEND_TYPES);
if (rank == 0) {
/* set up persistent sends... */
send_t_number = NUM_SEND_TYPES - NUM_PERSISTENT_SEND_TYPES;
MPI_Send_init (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Send_init (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
send_t_number++;
MPI_Bsend_init (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Bsend_init (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
send_t_number++;
MPI_Rsend_init (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Rsend_init (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
send_t_number++;
MPI_Ssend_init (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Ssend_init (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
}
for (k = 0; k < (NUM_COMPLETION_MECHANISMS * 2); k++) {
if (rank == 0) {
/* initialize all of the send buffers */
for (j = 0; j < NUM_SEND_TYPES; j++) {
for (i = 0; i < BUF_SIZE; i++) {
buf[2 * j * BUF_SIZE + i] = i;
buf[((2 * j + 1) * BUF_SIZE) + i] = BUF_SIZE - 1 - i;
}
}
}
else if (rank == 1) {
/* zero out all of the receive buffers */
bzero (buf, sizeof(int) * BUF_SIZE * 2 * NUM_SEND_TYPES);
}
MPI_Barrier(MPI_COMM_WORLD);
if (rank == 0) {
/* set up transient sends... */
send_t_number = 0;
MPI_Isend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Isend (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
send_t_number++;
MPI_Ibsend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Ibsend (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
send_t_number++;
/* Barrier to ensure receives are posted for rsends... */
MPI_Barrier(MPI_COMM_WORLD);
MPI_Irsend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Irsend (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
send_t_number++;
MPI_Issend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT,
1, send_t_number * 2, comm, &aReq[send_t_number * 2]);
MPI_Issend (&buf[(send_t_number * 2 + 1) * BUF_SIZE],
BUF_SIZE, MPI_INT, 1, send_t_number * 2 + 1,
comm, &aReq[send_t_number * 2 + 1]);
/* just to be paranoid */
send_t_number++;
assert (send_t_number == NUM_SEND_TYPES - NUM_PERSISTENT_SEND_TYPES);
/* start the persistent sends... */
if (k % 2) {
MPI_Startall (NUM_PERSISTENT_SEND_TYPES * 2, &aReq[2 * send_t_number]);
}
else {
for (j = 0; j < NUM_PERSISTENT_SEND_TYPES * 2; j++) {
MPI_Start (&aReq[2 * send_t_number + j]);
}
}
/* NOTE: Changing the send buffer of a Bsend is NOT an error... */
for (j = 0; j < NUM_SEND_TYPES; j++) {
/* muck the buffers */
buf[j * 2 * BUF_SIZE + (BUF_SIZE >> 1)] = BUF_SIZE;
}
printf ("USER MSG: 6 change send buffer errors in iteration #%d:\n", k);
/* complete the sends */
switch (k/2) {
case 0:
/* use MPI_Wait */
for (j = 0; j < NUM_SEND_TYPES * 2; j++) {
MPI_Wait (&aReq[j], &aStatus[j]);
}
break;
case 1:
/* use MPI_Waitall */
MPI_Waitall (NUM_SEND_TYPES * 2, aReq, aStatus);
break;
case 2:
/* use MPI_Waitany */
for (j = 0; j < NUM_SEND_TYPES * 2; j++) {
MPI_Waitany (NUM_SEND_TYPES * 2, aReq, &index, aStatus);
}
break;
case 3:
/* use MPI_Waitsome */
total = 0;
while (total < NUM_SEND_TYPES * 2) {
MPI_Waitsome (NUM_SEND_TYPES * 2, aReq, &outcount, indices, aStatus);
total += outcount;
}
break;
case 4:
/* use MPI_Test */
for (j = 0; j < NUM_SEND_TYPES * 2; j++) {
flag = 0;
while (!flag) {
MPI_Test (&aReq[j], &flag, &aStatus[j]);
}
}
break;
case 5:
/* use MPI_Testall */
flag = 0;
while (!flag) {
MPI_Testall (NUM_SEND_TYPES * 2, aReq, &flag, aStatus);
}
break;
case 6:
/* use MPI_Testany */
for (j = 0; j < NUM_SEND_TYPES * 2; j++) {
flag = 0;
while (!flag) {
MPI_Testany (NUM_SEND_TYPES * 2, aReq, &index, &flag, aStatus);
}
}
break;
case 7:
/* use MPI_Testsome */
total = 0;
while (total < NUM_SEND_TYPES * 2) {
outcount = 0;
while (!outcount) {
MPI_Testsome (NUM_SEND_TYPES * 2, aReq,
&outcount, indices, aStatus);
}
total += outcount;
}
break;
default:
assert (0);
break;
}
}
else if (rank == 1) {
/* Sets error_code to MPI_SUCCESS if successful, or creates an error code
* in the case of error.
*/
static void ADIOI_W_Exchange_data(ADIO_File fd, void *buf, char *write_buf,
ADIOI_Flatlist_node * flat_buf, ADIO_Offset
* offset_list, ADIO_Offset * len_list, int *send_size,
int *recv_size, ADIO_Offset off, int size,
int *count, int *start_pos,
int *partial_recv,
int *sent_to_proc, int nprocs,
int myrank, int
buftype_is_contig, int contig_access_count,
ADIO_Offset min_st_offset,
ADIO_Offset fd_size,
ADIO_Offset * fd_start, ADIO_Offset * fd_end,
ADIOI_Access * others_req,
int *send_buf_idx, int *curr_to_proc,
int *done_to_proc, int *hole, int iter,
MPI_Aint buftype_extent, MPI_Aint * buf_idx, int *error_code)
{
int i, j, k, *tmp_len, nprocs_recv, nprocs_send, err;
char **send_buf = NULL;
MPI_Request *requests, *send_req;
MPI_Datatype *recv_types;
MPI_Status *statuses, status;
int *srt_len = NULL, sum;
ADIO_Offset *srt_off = NULL;
static char myname[] = "ADIOI_W_EXCHANGE_DATA";
/* exchange recv_size info so that each process knows how much to
send to whom. */
MPI_Alltoall(recv_size, 1, MPI_INT, send_size, 1, MPI_INT, fd->comm);
/* create derived datatypes for recv */
nprocs_send = 0;
nprocs_recv = 0;
sum = 0;
for (i = 0; i < nprocs; i++) {
sum += count[i];
if (recv_size[i])
nprocs_recv++;
if (send_size[i])
nprocs_send++;
}
recv_types = (MPI_Datatype *)
ADIOI_Malloc((nprocs_recv + 1) * sizeof(MPI_Datatype));
/* +1 to avoid a 0-size malloc */
tmp_len = (int *) ADIOI_Malloc(nprocs * sizeof(int));
j = 0;
for (i = 0; i < nprocs; i++) {
if (recv_size[i]) {
/* take care if the last off-len pair is a partial recv */
if (partial_recv[i]) {
k = start_pos[i] + count[i] - 1;
tmp_len[i] = others_req[i].lens[k];
others_req[i].lens[k] = partial_recv[i];
}
ADIOI_Type_create_hindexed_x(count[i],
&(others_req[i].lens[start_pos[i]]),
&(others_req[i].mem_ptrs[start_pos[i]]),
MPI_BYTE, recv_types + j);
/* absolute displacements; use MPI_BOTTOM in recv */
MPI_Type_commit(recv_types + j);
j++;
}
}
/* To avoid a read-modify-write, check if there are holes in the
* data to be written. For this, merge the (sorted) offset lists
* others_req using a heap-merge. */
/* valgrind-detcted optimization: if there is no work on this process we do
* not need to search for holes */
if (sum) {
srt_off = (ADIO_Offset *) ADIOI_Malloc(sum * sizeof(ADIO_Offset));
srt_len = (int *) ADIOI_Malloc(sum * sizeof(int));
ADIOI_Heap_merge(others_req, count, srt_off, srt_len, start_pos, nprocs, nprocs_recv, sum);
}
/* for partial recvs, restore original lengths */
for (i = 0; i < nprocs; i++)
if (partial_recv[i]) {
k = start_pos[i] + count[i] - 1;
others_req[i].lens[k] = tmp_len[i];
}
ADIOI_Free(tmp_len);
/* check if there are any holes. If yes, must do read-modify-write.
* holes can be in three places. 'middle' is what you'd expect: the
* processes are operating on noncontigous data. But holes can also show
* up at the beginning or end of the file domain (see John Bent ROMIO REQ
* #835). Missing these holes would result in us writing more data than
* recieved by everyone else. */
*hole = 0;
if (sum) {
if (off != srt_off[0]) /* hole at the front */
*hole = 1;
else { /* coalesce the sorted offset-length pairs */
for (i = 1; i < sum; i++) {
if (srt_off[i] <= srt_off[0] + srt_len[0]) {
/* ok to cast: operating on cb_buffer_size chunks */
int new_len = (int) srt_off[i] + srt_len[i] - (int) srt_off[0];
if (new_len > srt_len[0])
srt_len[0] = new_len;
} else
break;
}
if (i < sum || size != srt_len[0]) /* hole in middle or end */
*hole = 1;
}
ADIOI_Free(srt_off);
ADIOI_Free(srt_len);
}
if (nprocs_recv) {
if (*hole) {
ADIO_ReadContig(fd, write_buf, size, MPI_BYTE,
ADIO_EXPLICIT_OFFSET, off, &status, &err);
/* --BEGIN ERROR HANDLING-- */
if (err != MPI_SUCCESS) {
*error_code = MPIO_Err_create_code(err,
MPIR_ERR_RECOVERABLE, myname,
__LINE__, MPI_ERR_IO, "**ioRMWrdwr", 0);
return;
}
/* --END ERROR HANDLING-- */
}
}
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
requests = (MPI_Request *)
ADIOI_Malloc((nprocs_send + 1) * sizeof(MPI_Request));
send_req = requests;
} else {
requests = (MPI_Request *)
ADIOI_Malloc((nprocs_send + nprocs_recv + 1) * sizeof(MPI_Request));
/* +1 to avoid a 0-size malloc */
/* post receives */
j = 0;
for (i = 0; i < nprocs; i++) {
if (recv_size[i]) {
MPI_Irecv(MPI_BOTTOM, 1, recv_types[j], i, myrank + i + 100 * iter,
fd->comm, requests + j);
j++;
}
}
send_req = requests + nprocs_recv;
}
/* post sends. if buftype_is_contig, data can be directly sent from
user buf at location given by buf_idx. else use send_buf. */
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5032, 0, NULL);
#endif
if (buftype_is_contig) {
j = 0;
for (i = 0; i < nprocs; i++)
if (send_size[i]) {
MPI_Isend(((char *) buf) + buf_idx[i], send_size[i],
MPI_BYTE, i, myrank + i + 100 * iter, fd->comm, send_req + j);
j++;
buf_idx[i] += send_size[i];
}
} else if (nprocs_send) {
/* buftype is not contig */
size_t msgLen = 0;
for (i = 0; i < nprocs; i++)
msgLen += send_size[i];
send_buf = (char **) ADIOI_Malloc(nprocs * sizeof(char *));
send_buf[0] = (char *) ADIOI_Malloc(msgLen * sizeof(char));
for (i = 1; i < nprocs; i++)
send_buf[i] = send_buf[i - 1] + send_size[i - 1];
ADIOI_Fill_send_buffer(fd, buf, flat_buf, send_buf,
offset_list, len_list, send_size,
send_req,
sent_to_proc, nprocs, myrank,
contig_access_count,
min_st_offset, fd_size, fd_start, fd_end,
send_buf_idx, curr_to_proc, done_to_proc, iter, buftype_extent);
/* the send is done in ADIOI_Fill_send_buffer */
}
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
j = 0;
for (i = 0; i < nprocs; i++) {
MPI_Status wkl_status;
if (recv_size[i]) {
MPI_Recv(MPI_BOTTOM, 1, recv_types[j], i, myrank + i + 100 * iter,
fd->comm, &wkl_status);
j++;
}
}
}
for (i = 0; i < nprocs_recv; i++)
MPI_Type_free(recv_types + i);
ADIOI_Free(recv_types);
#ifdef MPI_STATUSES_IGNORE
statuses = MPI_STATUSES_IGNORE;
#else
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
statuses = (MPI_Status *) ADIOI_Malloc((nprocs_send + 1) * sizeof(MPI_Status));
/* +1 to avoid a 0-size malloc */
} else {
statuses = (MPI_Status *) ADIOI_Malloc((nprocs_send + nprocs_recv + 1) *
sizeof(MPI_Status));
/* +1 to avoid a 0-size malloc */
}
#endif
#ifdef NEEDS_MPI_TEST
i = 0;
if (fd->atomicity) {
/* bug fix from Wei-keng Liao and Kenin Coloma */
while (!i)
MPI_Testall(nprocs_send, send_req, &i, statuses);
} else {
while (!i)
MPI_Testall(nprocs_send + nprocs_recv, requests, &i, statuses);
}
#else
if (fd->atomicity)
/* bug fix from Wei-keng Liao and Kenin Coloma */
MPI_Waitall(nprocs_send, send_req, statuses);
else
MPI_Waitall(nprocs_send + nprocs_recv, requests, statuses);
#endif
#ifdef AGGREGATION_PROFILE
MPE_Log_event(5033, 0, NULL);
#endif
#ifndef MPI_STATUSES_IGNORE
ADIOI_Free(statuses);
#endif
ADIOI_Free(requests);
if (!buftype_is_contig && nprocs_send) {
ADIOI_Free(send_buf[0]);
ADIOI_Free(send_buf);
}
}
int main( int argc, char* argv[] )
{
int myrank, nprocs;
int val, val2;
int idx, idx2[2];
int flag;
MPI_Request req;
MPI_Request req2[2];
MPI_Status stat;
MPI_Init( &argc, &argv );
MPI_Comm_rank( MPI_COMM_WORLD, &myrank );
MPI_Comm_size( MPI_COMM_WORLD, &nprocs );
if( nprocs<2 ) {
fprintf(stderr, "Need at least 2 procs to run this program\n");
MPI_Abort(MPI_COMM_WORLD, 1);
return 1;
}
/* MPI_STATUS_IGNORE in MPI_Recv */
switch(myrank) {
case 0:
MPI_Send( &val, 1, MPI_INTEGER, 1, 33, MPI_COMM_WORLD);
break;
case 1:
MPI_Recv( &val, 1, MPI_INTEGER, 0, 33, MPI_COMM_WORLD, MPI_STATUS_IGNORE );
break;
}
/* MPI_STATUS_IGNORE in MPI_Wait, MPI_Test */
switch(myrank) {
case 0:
MPI_Isend( &val, 1, MPI_INTEGER, 1, 34, MPI_COMM_WORLD, &req);
MPI_Test( &req, &flag, MPI_STATUS_IGNORE );
MPI_Wait( &req, MPI_STATUS_IGNORE );
break;
case 1:
MPI_Recv( &val, 1, MPI_INTEGER, 0, 34, MPI_COMM_WORLD, &stat );
break;
}
/* MPI_STATUS_IGNORE in MPI_Waitany, MPI_Testany */
switch(myrank) {
case 0:
MPI_Isend( &val, 1, MPI_INTEGER, 1, 35, MPI_COMM_WORLD, &(req2[0]));
MPI_Isend( &val2, 1, MPI_INTEGER, 1, 36, MPI_COMM_WORLD, &(req2[1]));
MPI_Testany( 2, req2, &idx, &flag, MPI_STATUS_IGNORE );
MPI_Waitany( 2, req2, &idx, MPI_STATUS_IGNORE );
break;
case 1:
MPI_Recv( &val, 1, MPI_INTEGER, 0, 35, MPI_COMM_WORLD, &stat );
MPI_Recv( &val2, 1, MPI_INTEGER, 0, 36, MPI_COMM_WORLD, &stat );
break;
}
/* MPI_STATUSES_IGNORE in MPI_Waitall, MPI_Testall */
switch(myrank) {
case 0:
MPI_Isend( &val, 1, MPI_INTEGER, 1, 35, MPI_COMM_WORLD, &(req2[0]));
MPI_Isend( &val2, 1, MPI_INTEGER, 1, 36, MPI_COMM_WORLD, &(req2[1]));
MPI_Testall( 2, req2, &flag, MPI_STATUSES_IGNORE );
MPI_Waitall( 2, req2, MPI_STATUSES_IGNORE );
break;
case 1:
MPI_Recv( &val, 1, MPI_INTEGER, 0, 35, MPI_COMM_WORLD, &stat );
MPI_Recv( &val2, 1, MPI_INTEGER, 0, 36, MPI_COMM_WORLD, &stat );
break;
}
/* MPI_STATUSES_IGNORE in MPI_Waitsome */
switch(myrank) {
case 0:
MPI_Isend( &val, 1, MPI_INTEGER, 1, 35, MPI_COMM_WORLD, &(req2[0]));
MPI_Isend( &val2, 1, MPI_INTEGER, 1, 36, MPI_COMM_WORLD, &(req2[1]));
MPI_Testsome( 2, req2, &idx, idx2, MPI_STATUSES_IGNORE );
MPI_Waitsome( 2, req2, &idx, idx2, MPI_STATUSES_IGNORE );
break;
case 1:
MPI_Recv( &val, 1, MPI_INTEGER, 0, 35, MPI_COMM_WORLD, &stat );
MPI_Recv( &val2, 1, MPI_INTEGER, 0, 36, MPI_COMM_WORLD, &stat );
break;
}
MPI_Barrier(MPI_COMM_WORLD);
fprintf(stderr, "%5d: DONE\n", myrank);
MPI_Finalize();
}
int main( int argc, char **argv )
{
MPI_Datatype *types;
void **inbufs, **outbufs;
char **names;
int *counts, *bytesize, ntype;
MPI_Comm comms[20];
int ncomm = 20, rank, np, partner, tag;
int i, j, k, err, toterr, world_rank;
MPI_Status status, statuses[2];
int flag;
char *obuf;
MPI_Request requests[2];
MPI_Init( &argc, &argv );
AllocateForData( &types, &inbufs, &outbufs, &counts, &bytesize,
&names, &ntype );
GenerateData( types, inbufs, outbufs, counts, bytesize, names, &ntype );
MPI_Comm_rank( MPI_COMM_WORLD, &world_rank );
MakeComms( comms, 20, &ncomm, 0 );
/* Test over a wide range of datatypes and communicators */
err = 0;
for (i=0; i<ncomm; i++) {
MPI_Comm_rank( comms[i], &rank );
MPI_Comm_size( comms[i], &np );
if (np < 2) continue;
tag = i;
/* This is the test.
master: worker:
irecv send
isend
testall (fail)
sendrecv sendrecv
irecv
sendrecv sendrecv
wait
sendrecv sendrecv
testall (should succeed)
*/
for (j=0; j<ntype; j++) {
if (world_rank == 0 && verbose)
fprintf( stdout, "Testing type %s\n", names[j] );
if (rank == 0) {
/* Master */
partner = np - 1;
#if 0
MPIR_PrintDatatypePack( stdout, counts[j], types[j], 0, 0 );
#endif
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[0] );
/* Use issend to ensure that the test cannot complete */
MPI_Isend( inbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[1] );
/* Note that the send may have completed */
MPI_Testall( 2, &requests[0], &flag, statuses );
if (flag) {
err++;
fprintf( stderr, "MPI_Testall returned flag == true!\n" );
}
if (requests[1] == MPI_REQUEST_NULL) {
err++;
fprintf( stderr, "MPI_Testall freed a request\n" );
}
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
/* This should succeed, but may fail if the wait below is
still waiting */
MPI_Testall( 2, requests, &flag, statuses );
if (!flag) {
err++;
fprintf( stderr, "MPI_Testall returned flag == false!\n" );
}
if (requests[0] != MPI_REQUEST_NULL ||
requests[1] != MPI_REQUEST_NULL) {
err++;
fprintf( stderr, "MPI_Testall failed to free requests (test %d)\n", j );
if (requests[0] != MPI_REQUEST_NULL) {
fprintf( stderr, "Failed to free Irecv request\n" );
}
if (requests[1] != MPI_REQUEST_NULL) {
fprintf( stderr, "Failed to free Isend request\n" );
}
}
/* Check the received data */
if (CheckDataAndPrint( inbufs[j], outbufs[j], bytesize[j],
names[j], j )) {
err++;
}
}
else if (rank == np - 1) {
/* receiver */
partner = 0;
obuf = outbufs[j];
for (k=0; k<bytesize[j]; k++)
obuf[k] = 0;
MPI_Send( inbufs[j], counts[j], types[j], partner, tag,
comms[i] );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Irecv(outbufs[j], counts[j], types[j], partner, tag,
comms[i], &requests[0] );
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
MPI_Wait( requests, statuses );
if (CheckDataAndPrint( inbufs[j], outbufs[j], bytesize[j],
names[j], j )) {
err++;
}
MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
MPI_BOTTOM, 0, MPI_INT, partner, ncomm+i,
comms[i], &status );
}
}
}
if (err > 0) {
fprintf( stderr, "%d errors on %d\n", err, rank );
}
MPI_Allreduce( &err, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (world_rank == 0) {
if (toterr == 0) {
printf( " No Errors\n" );
}
else {
printf (" Found %d errors\n", toterr );
}
}
FreeDatatypes( types, inbufs, outbufs, counts, bytesize, names, ntype );
FreeComms( comms, ncomm );
MPI_Finalize();
return err;
}
