F95 Ошибка отправки / получения памяти при отправке массива - PullRequest
Новая
       110

F95 Ошибка отправки / получения памяти при отправке массива

0 голосов
/ 25 апреля 2020

Я новичок в параллельном программировании и пытаюсь произвести расчет разреженного матричного вектора в Fortran 95. Я работаю над подпрограммой, которая собирает только те компоненты вектора, к которым будет касаться разреженная матрица (вместо MPI_AllGather), но я продолжаю получать ошибки SIGSESV. Я знаю, это означает, что я попросил процесс коснуться чего-то, чего он не может / не существует, но я не могу на всю жизнь понять, что это может быть. 

!Gather the vector matrix in matrix vector multiplication for sparse matrices

subroutine sparsegather(u,BW,myid,nprocs)

  use header
  include "mpif.h"

  type(Vector), intent(inout) :: u
  integer,intent(in) :: BW !Bandwidth
  integer,intent(in) :: myid !process id
  integer,intent(in) :: nprocs !number of processes

  integer :: n, i
  integer,dimension(BW) :: rlr, rrr, slr, srr !Range of receive left/right, send left/right
  real(kind=rk),dimension(BW) :: rl, rr, sl, sr !Arrays of actual values

  integer :: ierr

  n = u%n  !Length of whole vector - used in periodic condition

  !Define ranges
  do i = 1,BW
     rlr(i) = u%ibeg - BW - 1 + i
     rrr(i) = u%iend + i

     srr(i) = u%iend - i + 1
     slr(i) = u%ibeg + i - 1
  end do

  !Periodic conditions
  do i = 1,BW
     if (rlr(i) < 1) then
        rlr(i) = rlr(i) + n
     end if
     if ((srr(i) < 1) then
        srr(i) = srr(i) + n
     end if
     if (rrr(i) > n ) then
        rrr(i) = rrr(i) - n
     end if
     if (slr(i) > n ) then
        slr(i) = slr(i) - n
     end if
  end do

  !Store the matrix values being sent over
  sl = u%xx(slr)
  sr = u%xx(srr)

  !Pass the value parcels around
  if (myid == 0) then 
     call MPI_Recv(rl,BW,MPI_DOUBLE_PRECISION,nprocs-1,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
     call MPI_Send(sr,BW,MPI_DOUBLE_PRECISION,myid+1,0,MPI_COMM_WORLD,ierr)
     call MPI_Recv(rr,BW,MPI_DOUBLE_PRECISION,myid+1,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
     call MPI_Send(sl,BW,MPI_DOUBLE_PRECISION,nprocs-1,0,MPI_COMM_WORLD,ierr)
  elseif (myid == nprocs-1) then
     call MPI_Send(sr,BW,MPI_DOUBLE_PRECISION,0,0,MPI_COMM_WORLD,ierr)
     call MPI_Recv(rl,BW,MPI_DOUBLE_PRECISION,myid-1,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
     call MPI_Send(sl,BW,MPI_DOUBLE_PRECISION,myid-1,0,MPI_COMM_WORLD,ierr)
     call MPI_Recv(rr,BW,MPI_DOUBLE_PRECISION,0,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
  elseif (mod(myid,2) == 0) then 
     call MPI_Recv(rl,BW,MPI_DOUBLE_PRECISION,myid-1,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
     call MPI_Send(sr,BW,MPI_DOUBLE_PRECISION,myid+1,0,MPI_COMM_WORLD,ierr)
     call MPI_Recv(rr,BW,MPI_DOUBLE_PRECISION,myid+1,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
     call MPI_Send(sl,BW,MPI_DOUBLE_PRECISION,myid-1,0,MPI_COMM_WORLD,ierr)
  else
     call MPI_Send(sr,BW,MPI_DOUBLE_PRECISION,myid+1,0,MPI_COMM_WORLD,ierr)
     call MPI_Recv(rl,BW,MPI_DOUBLE_PRECISION,myid-1,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
     call MPI_Send(sl,BW,MPI_DOUBLE_PRECISION,myid-1,0,MPI_COMM_WORLD,ierr)
     call MPI_Recv(rr,BW,MPI_DOUBLE_PRECISION,myid+1,MPI_ANY_TAG,MPI_COMM_WORLD,ierr)
  end if

  u%xx(rrr) = rr
  u%xx(rlr) = rl

end subroutine sparsegather

u - это объект с векторными значениями, хранящимися в %xx, и его размером в %n. Соответствующие начальная и конечная точки для каждого процессора находятся в %ibeg, а %iend.

BW - это полоса пропускания матрицы с разреженными полосами. Это уравнение имеет условия periodi c, поэтому значения слева от начала вектора переносятся на правую сторону (и наоборот), что делается в разделе условий periodi c.

...