Question

我是fortran和MPI的新手，目前正在不同的处理器上逐行处理非常大的矩阵。我会根据需要在所有处理器上收集所有结果。以下是与我的真实代码具有相同结构的示例代码。

我一直在有界函数iter的mod_test.f的49行MPI_Allgather中遇到SIGBUS问题。我该如何解决？

编译器详细信息：

$ 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

MPI_Allgather生成Sigbus

0 个答案: