Я предоставляю свои попытки создать тип данных MPI с MPI_Type_create_struct для отправки / получения типов OOP Fortran. Тип выглядит как
type :: mytype
integer :: id
logical :: flag
real, allocatable :: x(:)
real, allocatable :: y(:)
contains
procedure, pass :: ctor => mytype_ctor
end type
и, следовательно, является производным типом с размещаемыми массивами и процедурами с привязкой к типу.
Как создать тип данных MPI для этого типа?
Я попробовал два vaiants, и ни один из них не сработал.
Первый вариант пытается явно установить карту типов из типов внутри производного типа mytype. Он использует MPI_Type_get_extent для расчета смещений. MPI_send и MPI_recv выполняются во время выполнения без ошибок. Но при доступе к массиву элементов x через write возникает ошибка времени выполнения SIGSEGV.
* * Второй вариант использует фиктивный экземпляр mytype для чтения начальных адресовчленов mytype напрямую. Типовая карта, которая возвращается - с моей точки зрения - ерунда. Адреса разбросаны по всему пространству адресов. Отправка и получение не работает во время выполнения. MPI_send приводит к SIGSEGV.
Существует ли стандартный способ переноса производных типов с назначаемыми элементами и процедурами через MPI?
Я использую mpifort(verion 18.0.5) для компиляции и запуска с mpirun -n 2 (версия 3.1.0). Минимальным примером являются следующие модуль и основная программа.
module mod
use MPI
implicit none
save
integer :: MPI_mytype_v1
integer :: MPI_mytype_v2
type :: mytype
integer :: id
logical :: flag
real, allocatable :: x(:)
real, allocatable :: y(:)
contains
procedure, pass :: ctor => mytype_ctor
end type
contains
subroutine mytype_ctor(this, nx, ny)
implicit none
class(mytype), intent(inout) :: this
integer, intent(in) :: nx, ny
allocate(this%y(ny))
allocate(this%x(nx))
end subroutine
subroutine MPI_create_mytype_v1(nx,ny)
implicit none
integer, intent(in) :: nx, ny
integer :: types(4), bsize(4)
integer(KIND=MPI_ADDRESS_KIND) :: displacement(4), types_extents(4), lb(4)
integer i, err, rank
bsize = [ 1, 1, nx, ny ]
types = [ MPI_INTEGER, MPI_LOGICAL, MPI_REAL, MPI_REAL ]
do i=1, 4
call MPI_Type_get_extent(types(i), lb(i), types_extents(i), err)
enddo
do i=1, 4
displacement(i) = sum( bsize(1:i-1)*types_extents(1:i-1) )
enddo
call MPI_Comm_rank(MPI_COMM_WORLD, rank, err)
if(rank==0) then
write(*,'(a)' ) 'creation with method 1 - layout'
write(*,'(a,4I5)') 'size ', bsize
write(*,'(a,4I5)') 'type ', types
write(*,'(a,4I5)') 'extnt ', types_extents
write(*,'(a,4I5)') 'displ ', displacement
endif
call MPI_Type_create_struct(4, bsize, displacement, types, MPI_mytype_v1, err)
call MPI_Type_commit(MPI_mytype_v1, err);
end subroutine
subroutine MPI_create_mytype_v2(nx,ny)
implicit none
integer, intent(in) :: nx, ny
type(mytype) :: MTdummy
integer :: types(4), bsize(4)
integer(KIND=MPI_ADDRESS_KIND) :: displacement(4), address(4)
integer i, err, rank
bsize = [ 1, 1, nx, ny ]
types = [ MPI_INTEGER, MPI_LOGICAL, MPI_REAL, MPI_REAL ]
call mytype_ctor(MTdummy, nx,ny)
call MPI_get_Address(MTdummy%id, address(1), err)
call MPI_get_Address(MTdummy%flag, address(2), err)
call MPI_get_Address(MTdummy%x(1), address(3), err)
call MPI_get_Address(MTdummy%y(1), address(4), err)
do i=1, 4
displacement(i) = MPI_Aint_diff(address(i), address(1))
enddo
call MPI_Comm_rank(MPI_COMM_WORLD, rank, err)
if(rank==0) then
write(*,'(a)' ) 'creation with method 2 - layout'
write(*,'(a,4I5)' ) 'size ', bsize
write(*,'(a,4I5)' ) 'type ', types
write(*,'(a,4I25)') 'displ ', displacement
write(*,'(a,4I25)') 'adresses', address
endif
call MPI_Type_create_struct(4, bsize, displacement, types, MPI_mytype_v2, err)
call MPI_Type_commit(MPI_mytype_v2, err);
end subroutine
end module
program main
use mod
use MPI
implicit none
type(mytype) :: MT, MTrec
integer :: err, rank, n_procs
call MPI_Init(err)
call MPI_Comm_rank(MPI_COMM_WORLD, rank, err)
call MPI_Comm_size(MPI_COMM_WORLD, n_procs, err)
call MPI_create_mytype_v1(3,7)
call MPI_create_mytype_v2(3,7)
call mytype_ctor(MT,3,7)
if(rank==0) then
MT%id = 0
MT%flag = .true.
MT%x(:) = [+1,+2,+3]
MT%y(:) = [-1,-2,-3,-4,-5,-6,-7]
endif
if(rank==1) then
MT%id = 1
MT%flag = .false.
MT%x(:) = [0,0,0]
MT%y(:) = [0,1,2,4,8,16,32]
endif
if(rank==0) call MPI_Send( MT, 1, MPI_mytype_v1, 1, 1, MPI_COMM_WORLD, err)
! error on sending: if(rank==0) call MPI_Send( MT, 1, MPI_mytype_v2, 1, 2, MPI_COMM_WORLD, err)
if(rank==1) then
call mytype_ctor(MTrec,3,7)
call MPI_Recv( MTrec, 1, MPI_mytype_v1, 0, 1, MPI_COMM_WORLD, MPI_STATUS_IGNORE, err)
! call MPI_Recv( MTrec, 1, MPI_mytype_v2, 0, 2, MPI_COMM_WORLD, MPI_STATUS_IGNORE, err)
write(*,'(a,I0)') 'received id ', MTrec%id
write(*,'(a,L)' ) 'received flag', MTrec%flag
write(*,'(a,L)' ) 'is x alloc? ', allocated(MTrec%x)
write(*,'(a,G0)') 'received x ', MTrec%x(1)
write(*,'(a,G0)') 'received x ', MTrec%x(2)
write(*,'(a,G0)') 'received x ', MTrec%x(3)
write(*,'(a,7G0)') 'received y ', MTrec%y
endif
call MPI_finalize(err)
end program
Макет fixed выглядит как разумная карта типов.
creation with method 1 - layout
size 1 1 3 7
type 7 6 13 13
extnt 4 4 4 4
displ 0 4 8 20
Макет изПоиск адреса MPI кажется ошибочным.
creation with method 2 - layout
size 1 1 3 7
type 7 6 13 13
displ 0 4 -140732799234248 -140732798626120
adresses 140732823825384 140732823825388 24591136 25199264
При выполнении с первым вариантом тип данных получает отправку и получение. Запись его членов (и тест для выделения массива элементов x) дает:
received id 0
received flag T
is x alloc? T
forrtl: severe (174): SIGSEGV, segmentation fault occurred