Re: [OMPI devel] SM BTL hang issue

[Li-Ta Lo]

On Wed, 2007-08-29 at 14:06 -0400, Terry D. Dontje wrote:
> hmmm, interesting since my version doesn't abort at all.
> 


Some problem with fortran compiler/language binding? My C translation 
doesn't have any problem.

[ollie@exponential ~]$ mpirun -np 4 a.out 10
Target duration (seconds): 10.000000, #of msgs: 50331, usec per msg:
198.684707

Ollie


#include <stdlib.h>
#include <stdio.h>
#include <mpi.h>

int main(int argc, char *argv[])
{
    double duration = 10, endtime;
    long nmsgs = 1;
    int keep_going = 1, rank, size;
    MPI_Status status;

    MPI_Init(&argc, &argv);
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
    MPI_Comm_size(MPI_COMM_WORLD, &size);

    if (size == 1) {
	fprintf(stderr, "Need at least 2 processes\n");
    } else if (rank == 0) {
	duration = strtod(argv[1], NULL);
	endtime = MPI_Wtime() + duration;

	do {
	    MPI_Send(&keep_going, 1, MPI_INT, 1, 0x11, MPI_COMM_WORLD);
	    nmsgs += 1;
	} while (MPI_Wtime() < endtime);

	keep_going = 0;
	MPI_Send(&keep_going, 1, MPI_INT, 1, 0x11, MPI_COMM_WORLD);

	fprintf(stderr, "Target duration (seconds): %f, #of msgs: %d, usec per msg: %f\n",
		duration, nmsgs, 1.0e6*duration/nmsgs);
    } else {
	do {
	    MPI_Recv(&keep_going, 1, MPI_INT, rank-1, 0x11, MPI_COMM_WORLD, &status);

	    if (rank == (size-1))
		continue;

	    MPI_Send(&keep_going, 1, MPI_INT, rank+1, 0x11, MPI_COMM_WORLD);
	} while (keep_going);
    }

    MPI_Finalize();

}