MPI_Test isn't picking up a completed MPI_Send - interrupt

Question

I've spent three days looking for an answer so I hope you'll bear with me if this has already been addressed and I've been mighty unlucky finding a solution.
I'm using Fortran (eugh!) but this is a generic MPI query.
Scenario (simplified for this example):
Processes 0 and 1 communicate with process 2 (but not with each other)
0 & 1 do lots of sends/receives
2 does lots of receives/process/sends (but each pair is done twice so as to
pick up both 0 & 1)
0 & 1 will eventually stop - I know not when! - so I do an MPI_Send from each when appropriate using the rank of the 3rd process (filter_rank_id=2) and a special tag (c_tag_open_rcv=200), with a logical TRUE in the buffer (end_of_run). Like this:
CALL MPI_SEND(end_of_run, 1, MPI_LOGICAL, filter_rank_id, c_tag_open_rcv, mpi_coupling_comms, mpi_err)
The problem arises in process 2... it's busy doing its MPI_Recv/MPI_Send pairs and I cannot break out of it. I have set up a non-blocking receive for each of the other two processes and stored the request handles:
DO model_rank_id= 0, 1
!Set up a non-blocking receive to get notification of end of model run for each model
end_run = end_model_runs(model_rank_id) !this is an array of booleans initialised to FALSE
CALL MPI_IRECV(end_run, 1, MPI_LOGICAL, model_rank_id, &
c_tag_open_rcv, coupling_comms, mpi_request_handle, mpi_err)
!store the handle in an array
request_handles(model_rank_id) = mpi_request_handle
END DO
where model_rank_id is the process number in the MPI communicator i.e. 0 or 1.
Later on, busy doing all those receive/send pairs, I always check whether anything's arrived in the buffer:
DO model_rank_id= 0, 1
IF (end_model_runs(model_rank_id) .EQV. .FALSE.) THEN
CALL MPI_TEST(request_handles(model_rank_id), run_complete, mpi_status, mpi_err)
IF (run_complete .eqv. .FALSE.) THEN
!do stuff... receive/process/send
ELSE
!run is complete
!___________removed this as I realised it was incorrect__________
!get the stop flag for the specific process
CALL MPI_RECV(end_run, 1, MPI_LOGICAL, model_rank_id, &
c_tag_open_rcv, coupling_comms, mpi_err)
!____________end_________________________________________________
!store the stop flag so I can do a logical 'AND' on it and break out when
!both processes have sent their message
end_model_runs(model_rank_id) = end_run
END IF
END IF
END DO
Note that this snippet is contained in a loop which carries on until all the stop flags are TRUE.
I know it's fairly complex, but this can't be that hard, can it? If anyone can see the error that'd be fantastic, or even suggest a better way to do it.
Huge thanks in advance.

Answer 1

Your program is probably stuck in the MPI_RECV call. The reason is that having a positive completion flag as returned by MPI_TEST means that MPI_IRECV has received the message. Unless the sender sends another message with the same tag, MPI_RECV will simply block and wait, in your case probably indefinitely. Apart from that, you are issuing two MPI_IRECV calls with the same receive buffer which is probably not what you really want to do since end_run = end_model_runs(model_rank_id) does not copy the address of the array element into end_run but rather its value.
Your code should look like this:
DO model_rank_id= 0, 1
!Set up a non-blocking receive to get notification of end of model run for each model
CALL MPI_IRECV(end_model_runs(model_rank_id), 1, MPI_LOGICAL, model_rank_id, &
c_tag_open_rcv, coupling_comms, request_handle, ierr)
!store the handle in an array
request_handles(model_rank_id) = request_handle
END DO
...
DO model_rank_id= 0, 1
IF (end_model_runs(model_rank_id) .EQV. .FALSE.) THEN
CALL MPI_TEST(request_handles(model_rank_id), run_complete, status, ierr)
IF (run_complete .eqv. .FALSE.) THEN
!do stuff... receive/process/send
ELSE
!run is complete
!the stop flag is ALREADY in end_model_runs(model_rank_id)
!do a logical 'AND' on it and break out when
END IF
END IF
END DO
As a side note, using your own identifiers that start with mpi_ is a terrible idea since those might clash with symbols provided by the MPI library. You should really treat mpi_ as a reserved prefix and never use it while naming your own variables, subroutines, etc. I've fixed that for you in the code above.

Answer 2

I solved this eventually after a lot of experimentation, it was actually quite simple (isn't it always?)
The problem was due to the fact that processes 0 & 1 could end and post their "I'm finished" messages OK, but process 2 was in such a tight loop doing the test and recv/send pair (the outer loops on both sets of send/recv's omitted for clarity in original past), that the test would fail and the process would stick in the blocking MPI_RECV.
First I tried a sleep(3) which made it work, but it couldn't sleep on every loop without really bad effects on perfomance, then I tried an MPI_IPROBE but hit the same problem as the test. In the end, a timeout around the MPI_IPROBE did the trick, thus:
DO iter1 = 1, num_models
!Test each model in turn and ensure we do the comms until it has finished
IF (end_model_runs(iter1) .EQV. .FALSE.) THEN
model_rank_id= models(iter1)
now = TIME()
DO WHILE (TIME() .LT. now + timeout)
msg_flag = .FALSE.
CALL MPI_IPROBE(model_rank_id, c_tag, coupling_comms, &
msg_flag, empi_status, empi_err)
IF (msg_flag .EQV. .TRUE.) THEN
!Message waiting
EXIT
END IF
END DO
IF (msg_flag .EQV. .TRUE.) THEN
CALL MPI_RECV(state_vector, num_state_params, MPI_DOUBLE_PRECISION, &
model_rank_id, c_tag, coupling_comms, empi_status, empi_err)
ELSE !no message waiting, flag should be False, i.e. the run *has* finished
end_model_runs(iter1) = .NOT. msg_flag
END IF
END IF
END DO
and this code inside a loop which breaks once all the members of end_model_runs are TRUE.
I hope this helps someone else - and saves them three days of effort!