Li-Ta Lo wrote:

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

Did you oversubscribe? I found np=10 on a 8 core system clogged things up sufficiently.

--td

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();

}
------------------------------------------------------------------------

_______________________________________________
devel mailing list
de...@open-mpi.org
http://www.open-mpi.org/mailman/listinfo.cgi/devel

Reply via email to