Блог

Я пытаюсь упаковать массивы 1D и 2D двойной точности в структуру MPI в Fortran 90. Я успешно сделал это на C в очень похожей задаче, и процедура, похоже, почти точно такая же, но, похоже, я не могу понять, где я ошибаюсь, несмотря на чрезвычайно полезные коды ошибок MPI…

Я полагаю, что проблема заключается в вычислениях длины блока или смещения. Код компилируется и выполняется, когда вызов MPI_RECV() закомментирован, но приводит к ошибке, когда он раскомментирован.

main.f90

 program main
    use mymodule

    call MPI_INIT(ierr)
    call MPI_COMM_SIZE(MPI_COMM_WORLD, nPROC, ierr)
    call MPI_COMM_RANK(MPI_COMM_WORLD, myID, ierr)

    call PASS_MESH_MPI()

    call MPI_FINALIZE(ierr)

end program
  

mymodule.f90

 module mymodule
use mpi

double precision, dimension(:,:) :: U(0:10,0:10)
double precision, dimension(:) :: r(0:10), z(0:10)
integer, public :: ierr, nPROC, nWRs, myID, stat(MPI_STATUS_SIZE)

type mytype
      double precision, dimension(:,:), allocatable :: U
      double precision, dimension(:), allocatable :: r
      double precision, dimension(:), allocatable :: z
end type


contains

subroutine PASS_MESH_MPI()
implicit none
type(mytype) :: package
integer :: blocklen(3), types(3), myMPItype
integer(KIND=MPI_ADDRESS_KIND) :: displacement(3), base

    allocate( package%U(0:10,0:10) )
    allocate( package%r(0:10) )
    allocate( package%z(0:10) )

    call MPI_GET_ADDRESS(package%U, displacement(1), ierr)
    call MPI_GET_ADDRESS(package%r, displacement(2), ierr)
    call MPI_GET_ADDRESS(package%z, displacement(3), ierr)

    base = displacement(1)
    displacement(1) = displacement(1) - base
    displacement(2) = displacement(2) - base
    displacement(3) = displacement(3) - base

    blocklen(1) = (11)*(11)
    blocklen(2) = 11
    blocklen(3) = 11

    types(1) = MPI_DOUBLE_PRECISION
    types(2) = MPI_DOUBLE_PRECISION
    types(3) = MPI_DOUBLE_PRECISION

    call MPI_TYPE_CREATE_STRUCT(3, blocklen, displacement, types, myMPItype, ierr)
    call MPI_TYPE_COMMIT(myMPItype, ierr)

    if ( myID .eq. 0 ) then
        U(:,:) = 5
        r(:) = 5
        z(:) = 5
        package%r(:) = r(:)
        package%z(:) = z(:)
        package%U(:,:) = U(:,:)

        call MPI_SEND(package, 1, myMPItype, 1, 0, MPI_COMM_WORLD, ierr)
    end if

    if ( myID .ne. 0 ) then
        call MPI_RECV(package, 1, myMPItype, 0, 0, MPI_COMM_WORLD, stat, ierr)
    end if

    call MPI_TYPE_FREE( myMPItype, ierr )

end subroutine
end module
  

makefile

 COMP=mpif90
EXT=f90
CFLAGs=-Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g -fcheck=all -fbacktrace

PROG=TESTDAT.x
INPUT=input.dat
OUTPUT=output

TARGS=main.f90 mymodule.f90
OBJS=main.o mymodule.o

$(PROG): $(OBJS)
    $(COMP) $(CFLAGS) -o $(PROG) $(OBJS) $(LFLAGS)

mymodule.mod: mymodule.f90 mymodule.o
    $(COMP) -c $(CFLAGS) mymodule.f90

mymodule.o: mymodule.f90
    $(COMP) -c $(CFLAGS) mymodule.f90

main.o: main.f90 mymodule.mod
    $(COMP) -c $(CFLAGS) main.f90

run:
    make
    mpiexec -np 2 $(PROG)
    make clean

clean:
    rm -f $(PROG) *.mod *.o DONE watch
  

Вот ошибка, когда я пытаюсь запустить этот код с 2 процессами.

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

Backtrace for this error:
#0  0x1020d86fd
#1  0x1020d7a93
#2  0x7fff6f520b5c
--------------------------------------------------------------------------
Primary job  terminated normally, but 1 process returned
a non-zero exit code. Per user-direction, the job has been aborted.
--------------------------------------------------------------------------
--------------------------------------------------------------------------
mpiexec noticed that process rank 1 with PID 0 on node MacBook-Pro exited on signal 11 (Segmentation fault: 11).
--------------------------------------------------------------------------
  

И я видел, что этот несколько менее описательный тоже появился.

 Program received signal SIGABRT: Process abort signal.

Backtrace for this error:
#0  0x1046906fd
#1  0x10468fa93
#2  0x7fff6f520b5c
--------------------------------------------------------------------------
Primary job  terminated normally, but 1 process returned
a non-zero exit code. Per user-direction, the job has been aborted.
--------------------------------------------------------------------------
--------------------------------------------------------------------------
mpiexec noticed that process rank 1 with PID 0 on node MacBook-Pro exited on signal 6 (Abort trap: 6).
--------------------------------------------------------------------------
  

Я понимаю, что в инструкциях явно указано не вставлять полные файлы, но они довольно маленькие, и я надеялся сделать это более удобным для тех, кто хотел запустить код самостоятельно. Любая помощь будет с благодарностью!