Отправка 2D-массивов в Fortran с помощью MPI_Gather

Я хочу отправить 2d fragmentы данных с помощью MPI_GATHER. Например, у меня на каждом узле есть 2×3 массива, и я хочу, чтобы 8×3-массив был root, если у меня 4 узла. для 1d массивов MPI_GATHER сортирует данные по рейтингам MPI, но для 2d данных он создает беспорядок !. Каков чистый способ поместить куски в порядок?

Я ожидал вывода этого кода:

program testmpi use mpi implicit none integer :: send (2,3) integer :: rec (4,3) integer :: ierror,my_rank,i,j call MPI_Init(ierror) MPI_DATA_TYPE type_col ! find out process rank call MPI_Comm_rank(MPI_COMM_WORLD, my_rank, ierror) if (my_rank==0) then send=1 do i=1,2 print*,(send(i,j),j=1,3) enddo endif if (my_rank==1) then send=5 ! do 1,2 ! print*,(send(i,j),j=1,3) ! enddo endif call MPI_GATHER(send,6,MPI_INTEGER,rec,6,MPI_INTEGER,0,MPI_COMM_WORLD,ierror) if (my_rank==0) then print*,'rec' do i=1,4 print*,(rec(i,j),j=1,3) enddo endif call MPI_Finalize(ierror) end program testmpi 

что-то вроде этого:

  1 1 1 1 1 1 5 5 5 5 5 5 

но это выглядит так:

  1 1 5 1 1 5 1 5 5 1 5 5 

Следующий буквальный перевод Fortran этого ответа . Я думал, что это не нужно, но множественные различия в индексировании массива и макете памяти могут означать, что стоит сделать версию Fortran.

Позвольте мне начать с того, что вы вообще не хотите этого делать – разбросайте и соберите огромные куски данных из какого-то «мастер-процесса». Как правило, вы хотите, чтобы каждая задача отвлекалась на свой кусочек головоломки, и вы должны стремиться к тому, чтобы ни один процессор не нуждался в «глобальном представлении» всех данных; как только вы это потребуете, вы ограничите масштабируемость и размер проблемы. Если вы делаете это для ввода-вывода – один процесс считывает данные, затем рассеивает его, а затем собирает обратно для записи, вам нужно в конечном итоге просмотреть MPI-IO.

Однако, на ваш вопрос, MPI имеет очень хорошие способы вытащить произвольные данные из памяти, а также разбросать / собрать его и из набора процессоров. К сожалению, это требует значительного количества концепций MPI – типов MPI, экстентов и коллективных операций. В ответе на этот вопрос обсуждаются многие основные идеи – MPI_Type_create_subarray и MPI_Gather .

Рассмотрим 1d целочисленный глобальный массив, в задаче 0 которого вы хотите распространять несколько задач MPI, чтобы каждый из них получал кусок в своем локальном массиве. Скажем, у вас есть 4 задачи, а глобальный массив – [0,1,2,3,4,5,6,7]. У вас может быть задача 0 отправить четыре сообщения (в том числе один для себя), чтобы распределить это, и когда пришло время для повторной сборки, получите четыре сообщения, чтобы связать их вместе; но это, очевидно, занимает много времени при большом количестве процессов. Существуют оптимизированные процедуры для этих видов операций – операции разбрасывания / сбора. Итак, в этом случае вы делаете что-то вроде этого:

 integer, dimension(8) :: global ! only root has this integer, dimension(2) :: local ! everyone has this integer, parameter :: root = 0 integer :: rank, comsize integer :: i, ierr call MPI_Init(ierr) call MPI_Comm_size(MPI_COMM_WORLD, comsize, ierr) call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr) if (rank == root) then global = [ (i, i=1,8) ] endif call MPI_Scatter(global, 2, MPI_INTEGER, & ! send everyone 2 ints from global local, 2, MPI_INTEGER, & ! each proc recieves 2 into root, & ! sending process is root, MPI_COMM_WORLD, ierr) ! all procs in COMM_WORLD participate 

После этого данные процессоров будут выглядеть так:

 task 0: local:[1,2] global: [1,2,3,4,5,6,7,8] task 1: local:[3,4] global: [garbage] task 2: local:[5,6] global: [garbage] task 3: local:[7,8] global: [garbage] 

То есть операция рассеяния принимает глобальный массив и посылает смежные 2-цельные fragmentы всем процессорам.

Чтобы повторно собрать массив, мы используем операцию MPI_Gather (), которая работает точно так же, но наоборот:

 local = local + rank call MPI_Gather (local, 2, MPI_INTEGER, & ! everyone sends 2 ints from local global, 2, MPI_INTEGER, & ! root receives 2 ints each proc into global root, & ! receiving process is root, MPI_COMM_WORLD, ierr) ! all procs in COMM_WORLD participate 

И теперь массивы выглядят так:

 task 0: local:[1,2] global: [1,2,4,5,7,8,10,11] task 1: local:[4,5] global: [garbage-] task 2: local:[7,8] global: [garbage-] task 3: local:[10,11] global: [garbage-] 

Gather возвращает все данные.

Что произойдет, если количество точек данных равномерно не делит количество процессов, и нам нужно отправлять разные количества элементов в каждый процесс? Тогда вам понадобится обобщенная версия разброса, MPI_Scatterv , которая позволяет вам указывать количество отсчетов для каждого процессора и перемещение – где в глобальном массиве начинается эта часть данных. Итак, скажем, с теми же 4 задачами у вас был массив символов [a, b, c, d, e, f, g, h, i] с 9 символами, и вы собирались назначить каждый процесс двумя символами, кроме последнего , который получил три. Тогда вам понадобится

 character, dimension(9) :: global character, dimension(3) :: local integer, dimension(4) :: counts integer, dimension(4) :: displs if (rank == root) then global = [ (achar(i+ichar('a')), i=0,8) ] endif local = ['-','-','-'] counts = [2,2,2,3] displs = [0,2,4,6] mycounts = counts(rank+1) call MPI_Scatterv(global, counts, displs, & ! proc i gets counts(i) chars from displs(i) MPI_CHARACTER, & local, mycounts, MPI_CHARACTER, & ! I get mycounts chars into root, & ! root rank does sending MPI_COMM_WORLD, ierr) ! all procs in COMM_WORLD participate 

Теперь данные выглядят как

 task 0: local:"ab-" global: "abcdefghi" task 1: local:"cd-" global: *garbage* task 2: local:"ef-" global: *garbage* task 3: local:"ghi" global: *garbage* 

Вы теперь использовали dispav для распределения нерегулярных объемов данных. В каждом случае смещение равно двум * рангам (измеряется в символах, смещение – в единицах типов, отправляемых для разброса или полученных для сбора, обычно это не байты или что-то) с начала массива, а считается [2,2,2,3]. Если бы это был первый процессор, мы хотели иметь 3 символа, мы бы установили counts = [3,2,2,2], и смещения были бы [0,3,5,7]. Gatherv снова работает точно так же, как и наоборот; подсчеты и массивы вытеснений останутся неизменными.

Теперь, для 2D, это немного сложнее. Если мы хотим отправить 2d-подслои 2-го массива, данные, которые мы отправляем сейчас, уже не смежны. Если мы отправляем (скажем) 3×3 субблоки массива 6×6 на 4 процессора, данные, которые мы отправляем, имеют в нем дыры:

 2D Array --------- |000|222| |000|222| |000|222| |---+---| |111|333| |111|333| |111|333| --------- Actual layout in memory [000111000111000111222333222333222333] 

(Обратите внимание, что все высокопроизводительные вычисления сводятся к пониманию компоновки данных в памяти.)

Если мы хотим отправить данные, помеченные «1» на задачу 1, нам нужно пропустить три значения, отправить три значения, пропустить три значения, отправить три значения, пропустить три значения, отправить три значения. Второе осложнение заключается в том, что субрегионы останавливаются и запускаются; обратите внимание, что область «1» не начинается, когда область «0» останавливается; после последнего элемента области «0» следующее место в памяти происходит частично через область «1».

Сначала рассмотрим первую проблему с макетом – как вытащить только те данные, которые мы хотим отправить. Мы всегда могли просто скопировать все данные области «0» в другой смежный массив и отправить это; если мы планировали это достаточно тщательно, мы могли бы сделать это так, чтобы мы могли называть MPI_Scatter результатами. Но нам бы не пришлось переносить всю нашу основную структуру данных таким образом.

До сих пор все типы данных MPI, которые мы использовали, были простыми – MPI_INTEGER задает (скажем) 4 байта подряд. Однако MPI позволяет создавать собственные типы данных, которые описывают произвольно сложные макеты данных в памяти. И этот случай – прямоугольные субрегионы массива – достаточно распространен, что для этого существует конкретный вызов . Для двумерного случая, описанного выше,

 integer :: newtype; integer, dimension(2) :: sizes, subsizes, starts sizes = [6,6] ! size of global array subsizes = [3,3] ! size of sub-region starts = [0,0] ! let's say we're looking at region "0" ! which begins at offset [0,0] call MPI_Type_create_subarray(2, sizes, subsizes, starts, MPI_ORDER_FORTRAN, MPI_INTEGER, newtype, ierr) call MPI_Type_commit(newtype, ierr) 

Это создает тип, который выбирает только область «0» из глобального массива. Обратите внимание, что даже в Fortran параметр start задается как смещение (например, на основе 0) от начала массива, а не индекс (например, 1 на основе).

Теперь мы можем отправить только эту часть данных другому процессору

 call MPI_Send(global, 1, newtype, dest, tag, MPI_COMM_WORLD, ierr) ! send region "0" 

и процесс приема может получить его в локальный массив. Обратите внимание, что процесс получения, если он принимает его только в массив 3×3, не может описать, что он получает как тип newtype; который больше не описывает макет памяти, поскольку между окончанием одной строки и началом следующего не происходит больших пропусков. Вместо этого он просто получает блок из 3 * 3 = 9 целых чисел:

 call MPI_Recv(local, 3*3, MPI_INTEGER, 0, tag, MPI_COMM_WORLD, ierr) 

Обратите внимание, что мы могли бы сделать это и для других субрегионов либо путем создания другого типа (с другим стартовым массивом) для других блоков, либо просто путем отправки, начиная с первого местоположения конкретного блока:

 if (rank == root) then call MPI_Send(global(4,1), 1, newtype, 1, tag, MPI_COMM_WORLD, ierr) call MPI_Send(global(1,4), 1, newtype, 2, tag, MPI_COMM_WORLD, ierr) call MPI_Send(global(4,4), 1, newtype, 3, tag, MPI_COMM_WORLD, ierr) local = global(1:3, 1:3) else call MPI_Recv(local, 3*3, MPI_INTEGER, 0, tag, MPI_COMM_WORLD, rstatus, ierr) endif 

Теперь, когда мы понимаем, как указывать субрегионы, перед использованием операций рассеяния / сбора есть еще одна вещь, и это «размер» этих типов. Мы не могли использовать MPI_Scatter () (или даже рассеяние) с этими типами еще, потому что эти типы имеют длину 15 целых чисел; то есть, где они заканчиваются на 15 целых чисел после их начала – и там, где они заканчиваются, не выстраиваются хорошо, где начинается следующий блок, поэтому мы не можем просто использовать разброс – он бы выбрал неправильное место для начала отправки данных к следующему процессору.

Конечно, мы могли бы использовать MPI_Scatterv () и сами определять перемещения, и это то, что мы будем делать, за исключением того, что смещения находятся в единицах размера отправляемого типа, и это тоже нам не помогает; блоки начинаются с смещений целых чисел (0,3,18,21) от начала глобального массива, а тот факт, что блок заканчивает 15 целых чисел от того, где он запускается, не позволяет нам выразить эти смещения в целых кратных значениях вообще ,

Чтобы справиться с этим, MPI позволяет вам установить размер этого типа для целей этих вычислений. Он не усекает тип; он просто используется для выяснения, где следующий элемент начинается с последнего элемента. Для таких типов, как эти с отверстиями в них, часто бывает необходимо установить, чтобы степень была чем-то меньшим, чем расстояние в памяти до фактического конца типа.

Мы можем установить, насколько это все, что нам удобно. Мы могли бы просто сделать размер 1 целым, а затем установить смещения в единицах целых чисел. В этом случае, однако, мне нравится указывать, что степень равна 3 целым числам – размер подколока – таким образом, блок «1» начинается сразу после блока «0», а блок «3» запускается сразу после блока « 2″ . К сожалению, это не очень хорошо работает, когда вы прыгаете из блока «2» в блок «3», но это не может помочь.

Поэтому, чтобы разброс субблоков в этом случае, мы сделали бы следующее:

 integer(kind=MPI_ADDRESS_KIND) :: extent starts = [0,0] sizes = [6, 6] subsizes = [3, 3] call MPI_Type_create_subarray(2, sizes, subsizes, starts, & MPI_ORDER_FORTRAN, MPI_INTEGER, & newtype, ierr) call MPI_Type_size(MPI_INTEGER, intsize, ierr) extent = 3*intsize call MPI_Type_create_resized(newtype, 0, extent, resizedtype, ierr) call MPI_Type_commit(resizedtype, ierr) 

Здесь мы создали тот же тип блока, что и раньше, но мы изменили его размер; мы не изменили, где тип «начинается» (0), но мы изменили его «завершение» (3 целых числа). Мы не упомянули об этом раньше, но MPI_Type_commit должен использовать этот тип; но вам нужно только зафиксировать конечный тип, который вы используете, а не какие-либо промежуточные шаги. Вы используете MPI_Type_free чтобы освободить фиксированный тип, когда закончите.

Итак, теперь, наконец, мы можем разбросать блоки: манипуляции с данными выше немного сложны, но как только это делается, рассеиватель выглядит так же, как и раньше:

 counts = 1 ! we will send one of these new types to everyone displs = [0,1,6,7] ! the starting point of everyone's data ! in the global array, in block extents call MPI_Scatterv(global, counts, displs, & ! proc i gets counts(i) types from displs(i) resizedtype, & local, 3*3, MPI_INTEGER, & ! I'm receiving 3*3 int root, MPI_COMM_WORLD, ierr) !... from (root, MPI_COMM_WORLD) 

И теперь мы закончили, после небольшого тура по разбросу, сбору и производным типам MPI.

Ниже приведен пример кода, который показывает как операцию сбора, так и операцию рассеяния с массивами символов. Запуск программы:

 $ mpirun -np 4 ./scatter2d global array is: 000222 000222 000222 111333 111333 111333 Rank 0 received: 000 000 000 Rank 1 received: 111 111 111 Rank 2 received: 222 222 222 Rank 3 received: 333 333 333 Rank 0 sending: 111 111 111 Rank 1 sending: 222 222 222 Rank 2 sending: 333 333 333 Rank 3 sending: 444 444 444 Root received: 111333 111333 111333 222444 222444 222444 

и следующий код:

 program scatter use mpi implicit none integer, parameter :: gridsize = 6 ! size of array integer, parameter :: procgridsize = 2 ! size of process grid character, allocatable, dimension (:,:) :: global, local integer, dimension(procgridsize**2) :: counts, displs integer, parameter :: root = 0 integer :: rank, comsize integer :: localsize integer :: i, j, row, col, ierr, p, charsize integer, dimension(2) :: sizes, subsizes, starts integer :: newtype, resizedtype integer, parameter :: tag = 1 integer, dimension(MPI_STATUS_SIZE) :: rstatus integer(kind=MPI_ADDRESS_KIND) :: extent, begin call MPI_Init(ierr) call MPI_Comm_size(MPI_COMM_WORLD, comsize, ierr) call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr) if (comsize /= procgridsize**2) then if (rank == root) then print *, 'Only works with np = ', procgridsize**2, ' for now.' endif call MPI_Finalize(ierr) stop endif localsize = gridsize/procgridsize allocate( local(localsize, localsize) ) if (rank == root) then allocate( global(gridsize, gridsize) ) forall( col=1:procgridsize, row=1:procgridsize ) global((row-1)*localsize+1:row*localsize, & (col-1)*localsize+1:col*localsize) = & achar(ichar('0')+(row-1)+(col-1)*procgridsize) end forall print *, 'global array is: ' do i=1,gridsize print *, global(i,:) enddo endif starts = [0,0] sizes = [gridsize, gridsize] subsizes = [localsize, localsize] call MPI_Type_create_subarray(2, sizes, subsizes, starts, & MPI_ORDER_FORTRAN, MPI_CHARACTER, & newtype, ierr) call MPI_Type_size(MPI_CHARACTER, charsize, ierr) extent = localsize*charsize begin = 0 call MPI_Type_create_resized(newtype, begin, extent, resizedtype, ierr) call MPI_Type_commit(resizedtype, ierr) counts = 1 ! we will send one of these new types to everyone forall( col=1:procgridsize, row=1:procgridsize ) displs(1+(row-1)+procgridsize*(col-1)) = (row-1) + localsize*procgridsize*(col-1) endforall call MPI_Scatterv(global, counts, displs, & ! proc i gets counts(i) types from displs(i) resizedtype, & local, localsize**2, MPI_CHARACTER, & ! I'm receiving localsize**2 chars root, MPI_COMM_WORLD, ierr) !... from (root, MPI_COMM_WORLD) do p=1, comsize if (rank == p-1) then print *, 'Rank ', rank, ' received: ' do i=1, localsize print *, local(i,:) enddo endif call MPI_Barrier(MPI_COMM_WORLD, ierr) enddo local = achar( ichar(local) + 1 ) do p=1, comsize if (rank == p-1) then print *, 'Rank ', rank, ' sending: ' do i=1, localsize print *, local(i,:) enddo endif call MPI_Barrier(MPI_COMM_WORLD, ierr) enddo call MPI_Gatherv( local, localsize**2, MPI_CHARACTER, & ! I'm sending localsize**2 chars global, counts, displs, resizedtype,& root, MPI_COMM_WORLD, ierr) if (rank == root) then print *, ' Root received: ' do i=1,gridsize print *, global(i,:) enddo endif call MPI_Type_free(newtype,ierr) if (rank == root) deallocate(global) deallocate(local) call MPI_Finalize(ierr) end program scatter 

Итак, это общее решение. Для вашего конкретного случая, когда мы просто добавляем строки, нам не нужен Gatherv, мы можем просто использовать сборку, потому что в этом случае все смещения одинаковы – до того, в случае блока 2d мы было одно смещение, идущее «вниз», а затем прыгает в этом перемещении, когда вы перешли «в» в следующий столбец блоков. Здесь смещение всегда в одной степени от предыдущей, поэтому нам не нужно явно давать перемещения. Таким образом, окончательный код выглядит так:

 program testmpi use mpi implicit none integer, dimension(:,:), allocatable :: send, recv integer, parameter :: nsendrows = 2, nsendcols = 3 integer, parameter :: root = 0 integer :: ierror, my_rank, comsize, i, j, ierr integer :: blocktype, resizedtype integer, dimension(2) :: starts, sizes, subsizes integer (kind=MPI_Address_kind) :: start, extent integer :: intsize call MPI_Init(ierror) call MPI_Comm_rank(MPI_COMM_WORLD, my_rank, ierror) call MPI_Comm_size(MPI_COMM_WORLD, comsize, ierror) allocate( send(nsendrows, nsendcols) ) send = my_rank if (my_rank==root) then ! we're going to append the local arrays ! as groups of send rows allocate( recv(nsendrows*comsize, nsendcols) ) endif ! describe what these subblocks look like inside the full concatenated array sizes = [ nsendrows*comsize, nsendcols ] subsizes = [ nsendrows, nsendcols ] starts = [ 0, 0 ] call MPI_Type_create_subarray( 2, sizes, subsizes, starts, & MPI_ORDER_FORTRAN, MPI_INTEGER, & blocktype, ierr) start = 0 call MPI_Type_size(MPI_INTEGER, intsize, ierr) extent = intsize * nsendrows call MPI_Type_create_resized(blocktype, start, extent, resizedtype, ierr) call MPI_Type_commit(resizedtype, ierr) call MPI_Gather( send, nsendrows*nsendcols, MPI_INTEGER, & ! everyone send 3*2 ints recv, 1, resizedtype, & ! root gets 1 resized type from everyone root, MPI_COMM_WORLD, ierr) if (my_rank==0) then print*,'<><><><><>recv' do i=1,nsendrows*comsize print*,(recv(i,j),j=1,nsendcols) enddo endif call MPI_Finalize(ierror) end program testmpi 

Запуск этого процесса с помощью 3 процессов дает:

 $ mpirun -np 3 ./testmpi <><><><><>recv 0 0 0 0 0 0 1 1 1 1 1 1 2 2 2 2 2 2 
Interesting Posts

Для включения Bluetooth Low Energy Scanning на Android 6.0 необходимо включить местоположение

Как можно программно настроить блокировку экрана с помощью пароля?

Единичные тесты, не обнаруженные в Visual Studio 2017

Добавить пустые столбцы в dataframe с указанными именами из вектора

Какое приложение вы используете для воспроизведения и управления музыкой на своем компьютере?

Как проверить одно поле, связанное с чужим значением в ASP.NET MVC 3

Сырье тела Expressjs

Оператор перегрузки <<: невозможно привязать lvalue к 'std :: basic_ostream &&’

System.BadImageFormatException: не удалось загрузить файл или сборку (из installutil.exe)

Windows: как добавить действие пакетного скрипта в меню правой кнопки мыши

Почему static_cast не может использоваться для down-cast, когда задействовано виртуальное наследование?

Какой самый быстрый способ сделать массовую вставку в Postgres?

выполнить команду оболочки из android

Файл все еще используется при попытке удалить корзину – как ее удалить?

Что означает «Объектная ссылка, не установленная на экземпляр объекта»?

Давайте будем гением компьютера.