MPI master unable to receive

Question

I am using MPI in fortran for computation of my data. I verified by printing the data that, computations are being performed on the desired rang by each process just fine but, it the master is unable to collate the data.

Here is the code that I am trying to make it work: EDIT: Created a tag which is constant for the send and recv

  integer :: tag
  tag = 123
  if(pid.ne.0) then
  print *,'pid: ',pid,'sending'
  DO j = start_index+1, end_index      
  CALL MPI_SEND(datapacket(j),1, MPI_REAL,0, tag, MPI_COMM_WORLD)
  !print *,'sending'
  END DO
  print *,'send complete'   

  else

  DO slave_id = 1, npe-1
    rec_start_index = slave_id*population_size+1
    rec_end_index = (slave_id + 1) * population_size;

  IF (slave_id == npe-1) THEN
      rec_end_index = total-1;        
  ENDIF
  print *,'received 1',rec_start_index,rec_end_index
    CALL MPI_RECV(datapacket(j),1,MPI_REAL,slave_id,tag,MPI_COMM_WORLD,  &
 &       status)  
  !print *,'received 2',rec_start_index,rec_end_index 
  END DO

It never prints received or anything after the MPI_RECV call but, I can see the sending happening just fine however, there is no way I can verify it except to rely on the print statements. The variable databpacket is initialized as follows:

real, dimension (:), allocatable :: datapacket

Is there any thing that I am doing wrong here?

EDIT: For the test setup all the process are being run on the localhost.

Answer 1

You are using different message tags for all the sends, however in your receive you use just j, which is never altered on the root process. Also note that your implementation looks like a MPI_Gather, which I'd recommend you to use instead of implementing this yourself.

EDIT: Sorry, after your update I now, realize, that you are in fact sending multiple messages from each rank>0 (start_index+1 up to end_index), if you need that, you do need to have tags differentiating the individual messages. However, you then also need to have multiple receives on your master. Maybe it would be better to state, what you actually want to achieve.

Do you want something like this:

integer :: tag
tag = 123
if(pid.ne.0) then

  print *,'pid: ',pid,'sending'
  CALL MPI_SEND(datapacket(start_index+1:end_index),end_index-start_index, MPI_REAL,0, tag, MPI_COMM_WORLD)
  !print *,'sending'
  print *,'send complete'   

else

  DO slave_id = 1, npe-1
    rec_start_index = slave_id*population_size+1
    rec_end_index = (slave_id + 1) * population_size;

    IF (slave_id == npe-1) THEN
      rec_end_index = total-1;        
    ENDIF
    print *,'received 1',rec_start_index,rec_end_index
    CALL MPI_RECV(datapacket(rec_start_index:rec_end_index),rec_end_index-rec_start_index+1,MPI_REAL,slave_id,tag,MPI_COMM_WORLD,  &
      &       status)  
    !print *,'received 2',rec_start_index,rec_end_index 
  END DO

end if