Как отправлять и получать массивы, используя структуру MPI в Fortran 90 - PullRequest
Новая
       17

Как отправлять и получать массивы, используя структуру MPI в Fortran 90

5 голосов
/ 08 апреля 2019

Я пытаюсь упаковать одномерные и двумерные массивы двойной точности в структуру 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).
--------------------------------------------------------------------------

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

...