MPI_Allgather генерирует Sigbus - PullRequest
Новая
       16

MPI_Allgather генерирует Sigbus

0 голосов
/ 27 декабря 2018

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

Я продолжаю сталкиваться с проблемами SIGBUS в MPI_Allgather, строка 49 из mod_test.f в ограниченной функции iter.Как я могу решить эту проблему?

Детали компилятора: 

$ mpifort --version
ifort (IFORT) 19.0.1.144 20181018
Copyright (C) 1985-2018 Intel Corporation.  All rights reserved.

Код скомпилирован следующим образом: 

mpifort mod_test.f main.f -o main -traceback -g -debug

mod_test.f 

    module TEST

      include "mpif.h"

      type A
      real     ,allocatable:: pf(:,:)
      integer              :: nx=100, ny=10
      contains
      procedure            :: init
      procedure            :: iter
      end type A

      type(A)                 :: A_obj

      contains

      integer function init(this, x, y)
      implicit none
      class(A)       , intent(inout):: this
      integer           , intent(in):: x, y

      this% nx = x
      this% ny = y

      allocate( this% pf(x, y) )
      this% pf = 0.0
      init = 1
      return
      end function init

      integer function iter(this, y_iter)
      implicit none
      class(A)       , intent(inout):: this
      integer           , intent(in):: y_iter
      integer                       :: i
      real               ,target    :: a(this%nx+1), ar(this%nx+1)
      real , dimension(:), pointer  :: abuff, arbuff

      a  = 0.0
      ar = 0.0

      do i = 1, this% nx
         this%pf(i, y_iter) = i * y_iter
      enddo

      a(1:this%nx) = this% pf(:, y_iter)
      a(this%nx+1) = y_iter

      call MPI_Allgather(a, this%nx+1, MPI_REAL, ar,
     &     this%nx+1, MPI_REAL,
     &     MPI_COMM_WORLD)

      write(*,*) "Reached after MPI_Allgather"
      do i = 1, this%nx + 1
         write(*,*)ar(i)
      enddo

      this% pf(:, ar(this%nx+1)) = ar(1:this%nx)
      write(*,*) "Got the solution from another processor"

      iter = 1
      end function iter

      subroutine INIT_A

      integer             :: j, rank, ierr, size

!     - Allocate
      ierr= A_obj% init(100, 10)

!     - Iterate
      call MPI_COMM_RANK( MPI_COMM_WORLD, rank, ierr)
      call MPI_COMM_SIZE( MPI_COMM_WORLD, size, ierr)

      do j = 1, A_obj % ny
         if ( rank == mod(j, size) ) then
            ierr = A_obj % iter( j )
         endif
      enddo

      end subroutine INIT_A

      end module TEST

main.f 

  PROGRAM MAIN

  use TEST

  implicit none

  integer       :: ierr

  call MPI_INIT(ierr)
  call INIT_A

  write(*,*) "Done with test"

  call MPI_FINALIZE(ierr)

  end PROGRAM MAIN
...