Мастер MPI не смог принять

Question

Я использую MPI в fortran для вычисления моих данных. Я проверял, распечатывая данные, что вычисления выполняются по желаемому звонку каждым процессом просто отлично, но мастер не может сопоставить данные.

Вот код, который я пытаюсь сделать его работу: EDIT: Созданный тег, который является постоянным для отправки и 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 

Он никогда не печатает received или что-нибудь после MPI_RECV вызова, но, Я вижу, что отправка происходит просто отлично, но я не могу проверить ее, кроме как полагаться на утверждения печати. Переменная databpacket инициализируется следующим образом:

real, dimension (:), allocatable :: datapacket 

Есть ли то, что я делаю неправильно здесь?

EDIT: для тестовой настройки весь процесс запускается на локальном хосте.

Answer 1

Вы используете разные теги сообщений для всех отправителей, однако в вашем приеме вы используете только j, который никогда не изменяется в корневом процессе. Также обратите внимание, что ваша реализация выглядит как MPI_Gather, которую я бы рекомендовал вам использовать вместо того, чтобы реализовать это самостоятельно.

EDIT: Извините, после вашего обновления теперь я понимаю, что вы фактически отправляете несколько сообщений из каждого ранга> 0 (start_index + 1 до end_index), если вам это нужно, вам нужно иметь теги, дифференцирующие отдельные сообщения. Тем не менее, вам также необходимо иметь несколько получателей на вашем хозяине. Возможно, было бы лучше указать, чего вы на самом деле хотите достичь.

Вы хотите что-то вроде этого:

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