Fortran MPI_GATHERV覆盖命令中未引用的数组

Fortran MPI_GATHERV覆盖命令中未引用的数组,fortran,mpi,gfortran,Fortran,Mpi,Gfortran,我对MPI有一个特殊的问题,MPI命令中没有引用的数组正在被覆盖,这是内存问题 在gatherv的第一个案例中,mpi按预期工作。在第二次调用gatherv时,来自第一个数组的信息将受到影响 我正在使用的代码相当大,但是我创建了一个独立的程序,大致显示了这个问题 然而,在较小的程序中,虽然仍然存在问题,但程序调用seg故障,而不是像较大的程序那样继续运行 program main use mpi integer :: chunksize, send_coun

我对MPI有一个特殊的问题,MPI命令中没有引用的数组正在被覆盖,这是内存问题

在gatherv的第一个案例中,mpi按预期工作。在第二次调用gatherv时,来自第一个数组的信息将受到影响

我正在使用的代码相当大,但是我创建了一个独立的程序,大致显示了这个问题

然而,在较小的程序中,虽然仍然存在问题,但程序调用seg故障,而不是像较大的程序那样继续运行


    program main

      use mpi

      integer :: chunksize, send_count, i_start, i_end
      integer, allocatable :: rec_starts(:), rec_counts(:)

      integer, parameter :: dp = 8; ! double precision

      REAL(DP), allocatable:: array_2d(:,:)
      REAL(DP), allocatable:: array_3d(:,:,:)

      INTEGER, parameter:: num_skill=5, num_pref=2

      INTEGER, parameter:: num_ed=3, num_children=2, num_age=4, num_market=28, num_health=2, num_year=2
      INTEGER, parameter:: num_total_state_m=num_children*num_market*num_year*num_ed*num_age*num_health*num_ed*num_age*num_health  

      real(dp), dimension(num_skill,num_total_state_m) :: array_2d_local
      real(dp), dimension(num_pref,num_pref,num_total_state_m) :: array_3d_local

      integer i,j,k,l,m

      !mpi vars
      integer :: ierr, ntasks, mpi_id



      ! Set up MPI
      call mpi_init(ierr)
      call mpi_comm_size(mpi_comm_world, ntasks, ierr) !get number of tasks
      call mpi_comm_rank(mpi_comm_world, mpi_id, ierr) !get id of each task
      write(*,*) 'process ', mpi_id+1, 'of ', ntasks, 'is alive,', ' mpi_id:',mpi_id

      !calculate which 'i' this thread is responsible for
            chunksize = (num_total_state_m + ntasks - 1) / ntasks !note int/int rounds down
            i_start = (mpi_id)*chunksize + 1
            i_end = min((mpi_id+1)*chunksize,num_total_state_m)

      !set up practice matrices
      allocate(array_2d(num_skill,num_total_state_m), &
           array_3d(num_pref,num_pref,num_total_state_m))

      l = 1
      m = -1
      do i=1,num_skill
         do j=1, num_total_state_m
            if (mpi_id==0) array_2d_local(i,j) = l
            if (mpi_id==1) array_2d_local(i,j) = m
            l = l + 1
            m = m - 1
         end do
      end do

      l = 1
      m = -1
      do i=1, num_pref
         do j=1, num_pref
            do k=1, num_total_state_m
               if (mpi_id==0) array_3d_local(i,j,k) = l
               if (mpi_id==1) array_3d_local(i,j,k) = m
               l = l + 1
               m = m - 1
            end do
         end do
      end do


      ! Next send matricies
      allocate(rec_starts(ntasks), rec_counts(ntasks))
      do i=1, ntasks
         rec_counts(i) = min(num_total_state_m, i * chunksize) - (i-1)*chunksize
         rec_starts(i) = (i-1) * chunksize
      end do
      rec_counts = rec_counts * num_skill
      rec_starts = rec_starts * num_skill
      send_count = rec_counts(mpi_id+1)


      ! -m  (dimensions:num_skill, num_total_state_m)  double
      call mpi_gatherv(array_2d_local(:,i_start:i_end), send_count, &
           mpi_double_precision, &
           array_2d, rec_counts, rec_starts, mpi_double_precision, &
           0, mpi_comm_world, ierr)

      ! Next do 3d array
      ! IF THESE LINES ARE UNCOMMENTED, THE PROGRAM WORKS FINE!
      !do i=1, ntasks
      !   rec_counts(i) = min(num_total_state_m, i * chunksize) - (i-1)*chunksize
      !   rec_starts(i) = (i-1) * chunksize
      !end do
      rec_counts = rec_counts * num_pref
      rec_starts = rec_starts * num_pref
      send_count = rec_counts(mpi_id+1)
      ! -array_3d    (num_pref,num_pref,num_total_state_m)double
      print*, array_2d(1,1), mpi_id, 'before'
      call mpi_gatherv(array_3d_local(:,:,i_start:i_end), send_count, &
           mpi_double_precision, &
           array_3d, rec_counts, rec_starts, mpi_double_precision, &
           0, mpi_comm_world, ierr)
      print*, array_2d(1,1), mpi_id, 'after'


      deallocate(rec_starts, rec_counts)
      deallocate(array_2d, array_3d)



    end program main

此较小程序中的输出如下所示:

    mpifort -fcheck=all -fbacktrace -g -Og -ffree-line-length-2048  main.f90 -o run_main
    mpiexec -np 2 run_main 2>&1 | tee run_main.log
     process            1 of            2 is alive, mpi_id:           0
     process            2 of            2 is alive, mpi_id:           1
       1.0000000000000000                0 before
       0.0000000000000000                1 before

    Program received signal SIGSEGV: Segmentation fault - invalid memory reference.

    Backtrace for this error:
    #0  0x101e87579
    #1  0x101e86945
    #2  0x7fff6a9ecb5c

在较大的程序中,如果程序没有故障,则打印输出如下所示

    1.0000000000000000                0 before
    0.0000000000000000                1 before
    -1.9018063100806379               0 after
    0.0000000000000000                1 after
我一直在看其他SO帖子:

但是,作为fortran/mpi的非专家,不幸的是,这些帖子的回复还不足以让我理解这个问题

非常感谢您提供的任何帮助或见解。谢谢

编辑:谢谢,我只是个白痴。如果其他人遇到此问题,请再次检查您的
记录和
显示

您的初始代码

  do i=1, ntasks
     rec_counts(i) = min(num_total_state_m, i * chunksize) - (i-1)*chunksize
     rec_starts(i) = (i-1) * chunksize
  end do
  rec_counts = rec_counts * num_skill
  rec_starts = rec_starts * num_skill
  send_count = rec_counts(mpi_id+1)
然后

  rec_counts = rec_counts * num_pref
  rec_starts = rec_starts * num_pref
  send_count = rec_counts(mpi_id+1)
你只是忘了除以
num\u skill
。 一个简单的修复方法是将最后三行替换为

  rec_counts = rec_counts * num_pref / num_skill
  rec_starts = rec_starts * num_pref / num_skill
  send_count = rec_counts(mpi_id+1)
如果您怀疑MPI库中存在错误,最好尝试其他错误(例如MPICH(派生)和Open MPI)。如果您的应用程序同时因这两种原因崩溃,那么很可能是您的应用程序中存在缺陷。

您的初始代码确实存在缺陷

  do i=1, ntasks
     rec_counts(i) = min(num_total_state_m, i * chunksize) - (i-1)*chunksize
     rec_starts(i) = (i-1) * chunksize
  end do
  rec_counts = rec_counts * num_skill
  rec_starts = rec_starts * num_skill
  send_count = rec_counts(mpi_id+1)
然后

  rec_counts = rec_counts * num_pref
  rec_starts = rec_starts * num_pref
  send_count = rec_counts(mpi_id+1)
你只是忘了除以
num\u skill
。 一个简单的修复方法是将最后三行替换为

  rec_counts = rec_counts * num_pref / num_skill
  rec_starts = rec_starts * num_pref / num_skill
  send_count = rec_counts(mpi_id+1)

如果您怀疑MPI库中存在错误,最好尝试其他错误(例如MPICH(派生)和Open MPI)。如果您的应用程序同时因这两种原因而崩溃,那么很可能是您的应用程序中存在错误。

请向我们展示您的完整程序,或者至少举一个最简单的示例,说明您遇到的问题。特别是在这里,如果不了解各种数组是如何分配的,就不可能回答您的问题,但更一般地说,如果没有完整的程序,在发布之前测试想法可能会非常困难和耗时,因此这些想法永远不会被发布……我现在将尝试将它们放在一起,谢谢。我认为这是rec_启动时的指针问题,第二次使用它时,它指向以前的内存。更完整的代码应该使这个问题更清楚,更容易解决。您好,我已经用一个独立的例子更新了这篇文章。我还找到了一个“修复”,但我仍然想了解这是否是一个已知的问题,或者交易是什么,这样我就不会在其他情况下陷入这个错误,如果我可能没有意识到这个错误,请向我们展示您的完整程序,或者至少是一个显示您存在问题的最小示例。特别是在这里,如果不了解各种数组是如何分配的,就不可能回答您的问题,但更一般地说,如果没有完整的程序,在发布之前测试想法可能会非常困难和耗时,因此这些想法永远不会被发布……我现在将尝试将它们放在一起,谢谢。我认为这是rec_启动时的指针问题,第二次使用它时,它指向以前的内存。更完整的代码应该使这个问题更清楚,更容易解决。您好,我已经用一个独立的例子更新了这篇文章。我还找到了一个“修复”,但我仍然想知道这是否是一个已知的问题,或者交易是什么,这样我就不会在其他情况下陷入这个错误,因为我可能没有意识到这个错误