Не существует специальной подпрограммы для универсального 'mpi_send - PullRequest
Новая
       9

Не существует специальной подпрограммы для универсального 'mpi_send

0 голосов
/ 05 февраля 2019 
subroutine collect(rank, nprocs, n_local, n_global, u_initial_local)

use mpi

implicit none

integer*8                           :: i_local_low, i_local_high
integer*8                           :: i_global_low, i_global_high
integer*8                           :: i_local, i_global
integer*8                           :: n_local, n_global
real*8                              :: u_initial_local(n_local)
real*8, dimension(:), allocatable   :: u_global
integer                             :: procs
integer*8                           :: n_local_procs

! Data declarations for MPI
integer     :: ierr ! error signal variable, Standard value - 0
integer     :: rank ! process ID (pid) / Number
integer     :: nprocs ! number of processors

! MPI send/ receive arguments
integer                             :: buffer(2)
integer, parameter                  :: collect1 = 10
integer, parameter                  :: collect2 = 20


! status variable - tells the status of send/ received calls
! Needed for receive subroutine
integer, dimension(MPI_STATUS_SIZE) :: status1

i_global_low  = (rank       *(n_global-1))/nprocs
i_global_high = ((rank+1)   *(n_global-1))/nprocs

if (rank > 0) then
    i_global_low = i_global_low - 1
end if

i_local_low = 0
i_local_high = i_global_high - i_global_low

if (rank == 0) then
    allocate(u_global(1:n_global))

    do i_local = i_local_low, i_local_high
        i_global = i_global_low + i_local - i_local_low
        u_global(i_global) = u_initial_local(i_local)
    end do

    do procs = 1,nprocs-1

        call MPI_RECV(buffer, 2, MPI_INTEGER, procs, collect1, MPI_COMM_WORLD, status1, ierr)

        i_global_low = buffer(1)
        n_local_procs = buffer(2)

        call MPI_RECV(u_global(i_global_low+1), n_local_procs, MPI_DOUBLE_PRECISION, procs, collect2, MPI_COMM_WORLD, status1, ierr)        
    end do

    print *, u_global

else

    buffer(1) = i_global_low
    buffer(2) = n_local


    call MPI_SEND(buffer, 2, MPI_INTEGER, 0, collect1, MPI_COMM_WORLD, ierr)


    call MPI_SEND(u_initial_local, n_local, MPI_DOUBLE_PRECISION, 0, collect2, MPI_COMM_WORLD, ierr)
end if

return
end subroutine collect

Я получаю сообщение об ошибке для MPI_SEND и MPI_RECV, соответствующих тегу collect2.Msgstr "Специальной подпрограммы для универсального 'mpi_recv' в (1) нет", и 1 находится в конце ....... ierr).MPI_SEND для тега collect2 отправляет массив, а MPI_RECV получает этот массив.Это не происходит для тега collect1.

1 Ответ

0 голосов
/ 05 февраля 2019

Ваш n_local равен integer*8, но должен быть integer (см. Как отладить ошибку компиляции на Fortran 90 "Нет специальной подпрограммы для универсального 'foo' в (1)"? ).

Есть много статей (например, https://blogs.cisco.com/performance/can-i-mpi_send-and-mpi_recv-with-a-count-larger-than-2-billion) о проблеме с большими массивами (больше, чем элементы maxint) и MPI. Если у вас есть проблемы с слишком большим n_local для integerВы можете использовать производные типы (например, MPI_Type_contiguous), чтобы уменьшить количество элементов, передаваемых процедурам MPI, чтобы оно вписывалось в 4-байтовое целое число.

...