Проблема с MPI_GATHER/MPI_GATHERV в F90 с производными типами данных

Question

У меня есть задача, в которой у меня будет несколько типов данных; символ, несколько целых чисел и значение двойной точности, которые представляют собой решение проблемы.

На данный момент у меня есть «игрушечная» программа F90, которая использует MPI со случайными числами и нарисованную строку символов для каждого процессора. Я хочу иметь тип данных, у которого есть символ и случайное число двойной точности вместе.

Я буду использовать MPI_REDUCE, чтобы получить минимальное значение для значений двойной точности. У меня будет тип данных для каждого процесса, объединенного с корнем (rank = 0) с помощью функции MPI_GATHERV.

Моя цель - совместить минимальное значение от случайных значений до типа данных. Это будет окончательный ответ. До сих пор я пробовал всевозможные идеи, но безуспешно. Я заканчиваю «forrtl: серьезный SIGSEGV, произошла ошибка сегментации».

Теперь я просмотрел несколько других сообщений. Например, я не могу использовать инструкцию «use mpif.h» для этой конкретной системы.

Но, наконец, вот код:

program fredtype 
    implicit none 
    include '/opt/apps/intel15/mvapich2/2.1/include/mpif.h' 



    integer rank,size,ierror,tag,status(MPI_STATUS_SIZE),i,np,irank 
    integer blocklen(2),type(2),num,rcount(4) 
    double precision :: x,aout 
    character(len=4) :: y 

    type, BIND(C) :: mytype 
    double precision :: x,aout,test 
    character :: y 
    end type mytype 

    type(mytype) :: foo,foobag(4) 
    integer(KIND=MPI_ADDRESS_KIND) :: disp(2),base 


    call MPI_INIT(ierror) 

call MPI_COMM_SIZE(MPI_COMM_WORLD,size,ierror) 
    call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierror) 

    aout = 99999999999.99 

    call random_seed() 
    call random_number(x) 



    if(rank.eq.0)y="dogs" 
    if(rank.eq.1)y="cats" 
    if(rank.eq.2)y="tree" 
    if(rank.eq.3)y="woof" 

    print *,rank,x,y 


    call MPI_GET_ADDRESS(foo%x,disp(1),ierror) 
    call MPI_GET_ADDRESS(foo%y,disp(2),ierror) 

    base = disp(1) 
call MPI_COMM_SIZE(MPI_COMM_WORLD,size,ierror) 
    call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierror) 

    aout = 99999999999.99 

    call random_seed() 
    call random_number(x) 



    if(rank.eq.0)y="dogs" 
    if(rank.eq.1)y="cats" 
    if(rank.eq.2)y="tree" 
    if(rank.eq.3)y="woof" 

    print *,rank,x,y 


    call MPI_GET_ADDRESS(foo%x,disp(1),ierror) 
    call MPI_GET_ADDRESS(foo%y,disp(2),ierror) 

    base = disp(1) 
call MPI_COMM_SIZE(MPI_COMM_WORLD,size,ierror) 
    call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierror) 

    aout = 99999999999.99 

    call random_seed() 
    call random_number(x) 



    if(rank.eq.0)y="dogs" 
    if(rank.eq.1)y="cats" 
    if(rank.eq.2)y="tree" 
    if(rank.eq.3)y="woof" 

    print *,rank,x,y 


    call MPI_GET_ADDRESS(foo%x,disp(1),ierror) 
    call MPI_GET_ADDRESS(foo%y,disp(2),ierror) 

    base = disp(1) 
    disp(2) = disp(2) - base 

    blocklen(1) = 1 
    blocklen(2) = 1 

    type(1) = MPI_DOUBLE_PRECISION 
    type(2) = MPI_CHARACTER 


    call MPI_TYPE_CREATE_STRUCT(2,blocklen,disp,type,foo,ierror) 
    call MPI_TYPE_COMMIT(foo,ierror) 




     call MPI_REDUCE(x,aout,1,MPI_DOUBLE_PRECISION,MPI_MIN,0,MPI_COMM_WORLD,i\ 
error) 

     call MPI_GATHER(num,1,MPI_INT,rcount,1,MPI_INT,0,MPI_COMM_WORLD) 
     call MPI_GATHERV(foo,num,type,foobag,rcount,disp,type,0,MPI_COMM_WORLD) 


     if(rank.eq.0)then 
      print *,'fin ',aout 

      end if 




end program fredtype 

Спасибо за любую помощь. С уважением, Erin

Answer 1

Ваш код определенно слишком запутан для меня, чтобы попытаться его полностью исправить. Так давайте предположим, что у вас есть тип mytype определяется следующим образом:

type, bind(C) :: mytype 
    double precision :: x, aout, test 
    character(len=4) :: y 
end type mytype 

(Rk:. Я добавить len=4 к определению y, как казалось, не хватает из исходного кода, который я мог бы быть неправильно, это что и если да, то просто настроить blocklen(2) в следующем коде соответственно)

Теперь давайте предположим, что вы хотите только передать x и y поля ваших переменных типа mytype. Для этого вам необходимо создать присвоенный производный тип MPI, используя сначала MPI_Type_create_struct(), чтобы определить основные типы и их местоположение в вашей структуре, а затем MPI_Type_create_resized(), чтобы определить истинную протяженность и нижнюю границу типа, включая дыры.

Трудная часть, как правило, предназначена для оценки того, какова нижняя граница и степень вашего типа Fortran. Здесь, когда вы включаете в поля, которые вы передаете первым и последним из них, и по мере добавления bind(C), вы можете просто использовать MPI_Type_get_extend(), чтобы получить эти сведения. Однако, если вы не включили x или y (которые являются первым и последним полем типа) в тип данных MPI, MPI_Type_get_extent() не вернул бы то, что вам было нужно. Поэтому я предлагаю вам альтернативу (немного более громоздким) подход, который, как мне кажется, всегда работают:

integer :: ierror, typefoo, tmptypefoo 
integer :: blocklen(2), types(2) 
type(mytype) :: foobag(4) 
integer(kind=MPI_ADDRESS_KIND) :: disp(2), lb, extent 

call MPI_Get_address(foobag(1), lb, ierror) 
call MPI_Get_address(foobag(1)%x, disp(1), ierror) 
call MPI_Get_address(foobag(1)%y, disp(2), ierror) 
call MPI_Get_address(foobag(2), extent, ierror) 
disp(1) = MPI_Aint_diff(disp(1), lb) 
disp(2) = MPI_Aint_diff(disp(2), lb) 
extent = MPI_Aint_diff(extent, lb) 
lb = 0 

blocklen(1) = 1 
blocklen(2) = 4 

types(1) = MPI_DOUBLE_PRECISION 
types(2) = MPI_CHARACTER 

call MPI_Type_create_struct(2, blocklen, disp, types, tmptypefoo, ierror) 
call MPI_Type_create_resized(tmptypefoo, lb, extent, typefoo, ierror) 
call MPI_Type_commit(typefoo, ierror) 

Так как вы можете видеть, lb служит в качестве базового адреса для перемещений в структуру, и тип типа вычисляется с использованием относительных адресов двух последовательных элементов массива типа mytype.
Затем мы создаем промежуточный тип данных MPI tmptypefoo, который содержит только информацию о фактических данных, которые мы передадим, и мы предоставим информацию о фактической нижней границе и размере типа Fortran в typefoo. Наконец, только последний должен быть зафиксирован, поскольку только он будет использоваться для передачи данных.