Assignment

Your assignment is to locate an error in the following program. The program is hanging before it gets to the print statement. The program is supposed to generate the number 10 on the process with rank-0, and send the number 10 to the other process. Compile the code with ifort and locate the source of the error.


PROGRAM WhyTheJobHangs INCLUDE 'mpif.h' INTEGER istatus(MPI_STATUS_SIZE) CALL MPI_INIT(IERR) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, mprocs, ierr) CALL MPI_COMM_RANK(mpi_COMM_WORLD, myrank, ierr) isbuf =1 itag = 1 IF (myrank == 0) THEN DO WHILE (isbuf .NE. 10) isbuf =isbuf+2 ENDDO CALL MPI_SEND(isbuf, 1, MPI_INTEGER, 1, itag, + MPI_COMM_WORLD, ierr) ELSEIF (myrank == 1) THEN CALL MPI_RECV( irbuf, 1, MPI_INTEGER, 0, itag, + MPI_COMM_WORLD, istatus, ierr) PRINT*, ' I RECEIVED irbuf =', irbuf ENDIF CALL MPI_FINALIZE(ierr) END

Details

cut and paste the program into send.f

ifort -g -lmpi -o send send.f

mpirun -np 2 ./send

This program will hang and produce no output. Press Control-C to kill the job.

Tips

• Launch totalview with:
  totalview mpirun -a -np 2 ./send
• Click the button "Go"
• When asked if you want to stop the job, respond "Yes"
• You can set a breakpoint on either process 0 or process 1.
• Determine which process is causing the program to hang.

A solution

In the loop that incriments isbuf, it should only incriment by 1 at a time instead of 2. Alternatively, the initial value of isbuf could be set to a small even number.

PROGRAM WhyTheJobHangs INCLUDE 'mpif.h' INTEGER istatus(MPI_STATUS_SIZE) CALL MPI_INIT(IERR) CALL MPI_COMM_SIZE(MPI_COMM_WORLD, mprocs, ierr) CALL MPI_COMM_RANK(mpi_COMM_WORLD, myrank, ierr) isbuf =0 itag = 1 IF (myrank == 0) THEN DO WHILE (isbuf .NE. 10) isbuf =isbuf+2 ENDDO CALL MPI_SEND(isbuf, 1, MPI_INTEGER, 1, itag, + MPI_COMM_WORLD, ierr) ELSEIF (myrank == 1) THEN CALL MPI_RECV( irbuf, 1, MPI_INTEGER, 0, itag, + MPI_COMM_WORLD, istatus, ierr) PRINT *, ' I RECEIVED irbuf =', irbuf ENDIF CALL MPI_FINALIZE(ierr) END