PROGRAM Avoidlock
!-----------------------------------------------------------------
! Deadlock avoided breaking the Send/Receive symmetry
!-----------------------------------------------------------------

IMPLICIT NONE
INCLUDE "mpif.h"
INTEGER:: err, nproc, myid
INTEGER,DIMENSION(MPI_STATUS_SIZE):: status
INTEGER, PARAMETER:: N=100000000
REAL:: a(N), b(N)

CALL MPI_INIT (err)
CALL MPI_COMM_SIZE (MPI_COMM_WORLD, nproc, err)
CALL MPI_COMM_RANK (MPI_COMM_WORLD, myid, err)

IF (myid==0)  THEN
    a = 0
    CALL MPI_RECV (b, N, MPI_REAL, 1, 8, MPI_COMM_WORLD, status, err)
    CALL MPI_SEND (a, N, MPI_REAL, 1, 9, MPI_COMM_WORLD, err)
    WRITE(*,*) "Process", myid, "b =", b(1:3), "..."
ELSE
    b = 1
    CALL MPI_SEND (b, N, MPI_REAL, 0, 8, MPI_COMM_WORLD, err)
    CALL MPI_RECV (a, N, MPI_REAL, 0, 9, MPI_COMM_WORLD, status, err)
    WRITE(*,*) "Process", MYID, "a =", a(1:3), "..."
END IF

CALL MPI_FINALIZE (err)
END PROGRAM Avoidlock
