Напишите несколько распределенных массивов с MPI IO

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

Поэтому я пытаюсь использовать MPI-IO для прямой записи файла из распределенных массивов. Одно из ограничений, которое у меня есть, заключается в том, что записанный файл должен соответствовать "неотформатированному" формату на Фортране (т.е. 4-байтовое целое число до и после каждого поля, указывающего его размер).

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

Вот пример кода:

module arrays_dim
   implicit none
   INTEGER,        PARAMETER :: dp   = kind(0.d0) 
   integer,        parameter :: imax = 500 
   integer,        parameter :: jmax = 50 
   integer,        parameter :: kmax = 10 
end module arrays_dim
module mpi_vars
   use mpi 
   implicit none
   integer, save          :: ierr, myID, numprocs
   integer, save          :: i_start, i_end, i_mean, i_loc
   integer, save          :: subArray, fileH
   integer(MPI_OFFSET_KIND), save   :: offset, currPos
end module mpi_vars

program test
   use mpi 
   use arrays_dim
   use mpi_vars
   real(dp), dimension(0:imax,0:jmax+1,0:kmax+1) :: v, w
   real(dp), dimension(:,:,:), allocatable       :: v_loc, w_loc
   integer                                       :: i, j, k

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

   i_mean = (imax+1)/numprocs
   i_start = myID*i_mean
   i_end   = i_start+i_mean-1
   if(i_mean*numprocs<imax+1) then 
    if(myID == numprocs-1) i_end = imax
   endif
   i_loc = i_end - i_start + 1
   allocate(v_loc(i_start:i_end,0:jmax+1,0:kmax+1))
   allocate(w_loc(i_start:i_end,0:jmax+1,0:kmax+1))

   print*, 'I am:', myID, i_start, i_end, i_loc
   do k=0,kmax+1
      do j=0,jmax+1
         do i=0,imax
            v(i,j,k) = i+j+k
            w(i,j,k) = i*j*k
         enddo
      enddo
   enddo

   if(myID==0) then 
       open(10,form='unformatted')
       write(10) v
       !write(10) w
       close(10)
   endif

   do k=0,kmax+1
      do j=0,jmax+1
         do i=i_start,i_end
            v_loc(i,j,k) = i+j+k
            w_loc(i,j,k) = i*j*k
         enddo
      enddo
   enddo

   call MPI_Type_create_subarray (3, [imax+1, jmax+2, kmax+2], [i_loc, jmax+2, kmax+2], &
                                     [i_start, 0, 0], &
                                    MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, subArray,  ierr)
   call MPI_Type_commit(subArray, ierr)
   call MPI_File_open(MPI_COMM_WORLD, 'mpi.dat',         &
                     MPI_MODE_WRONLY + MPI_MODE_CREATE + MPI_MODE_APPEND, &
                     MPI_INFO_NULL, fileH, ierr )   


   call saveMPI(v_loc, (i_loc)*(jmax+2)*(kmax+2))
   !call saveMPI(w_loc, (i_loc)*(jmax+2)*(kmax+2))

   call MPI_File_close(fileH, ierr)      

   deallocate(v_loc,w_loc)
   call MPI_FINALIZE(ierr) 
end program test
!
subroutine saveMPI(array, n)
   use mpi
   use arrays_dim
   use mpi_vars

   implicit none
   real(dp), dimension(n) :: array
   integer                   :: n

   offset = (imax+1)*(jmax+2)*(kmax+2)*8
   if(myID==0) then
     call MPI_File_seek(fileH, int(0,MPI_OFFSET_KIND), MPI_SEEK_CUR, ierr)
     call MPI_File_write(fileH, [(imax+1)*(jmax+2)*(kmax+2)*8], 1, MPI_INTEGER, MPI_STATUS_IGNORE, ierr)
     call MPI_File_seek(fileH, offset, MPI_SEEK_CUR, ierr)
     call MPI_File_write(fileH, [(imax+1)*(jmax+2)*(kmax+2)*8], 1, MPI_INTEGER, MPI_STATUS_IGNORE, ierr)
   endif 
   call MPI_File_set_view(fileH, int(4,MPI_OFFSET_KIND), MPI_DOUBLE_PRECISION, subArray, 'native', MPI_INFO_NULL, ierr)
   call MPI_File_write_all(fileH, array, (i_loc)*(jmax+2)*(kmax+2), MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr)  
end subroutine saveMPI

когда линии !write(10) w а также !call saveMPI(w_loc, (i_loc)*(jmax+2)*(kmax+2)) комментируются (т.е. я пишу только массив v), код работает нормально:

mpif90.openmpi -O3 -o prog main.f90
mpirun.openmpi -np 4 ./prog
cmp mpi.dat fort.10

CMP не генерирует вывод, поэтому файлы идентичны. Однако если я раскомментирую эти строки, то получающиеся файлы (mpi.dat и fort.10) будут другими. Я уверен, что проблема заключается в том, как я определяю смещение, которое я использую для записи данных в нужную позицию файла, но я не знаю, как указать второму вызову saveMPI, что начальная позиция должна быть концом файла. Что мне не хватает?

1 ответ

Решение

Только первый звонок saveMPI работает так, как вы ожидаете. Все перепутано со второго вызова. Вот несколько признаков того, что происходит:

  • MPI_File_set_view сбрасывает независимые файловые указатели и указатель общего файла на ноль. Смотрите MPI_File_set_view для более подробной информации. Таким образом, вы на самом деле перезаписываете v данные с w данные при звонке MPI_File_set_view в saveMPI,
  • с MPI_File_write данные записываются в те части файла, которые определены текущим представлением. Это означает, что способ, которым вы добавляете информацию о размере в файл, не совсем совместим с представлением, предварительно установленным для v,
  • призвание MPI_File_seek с MPI_SEEK_CUR установить положение относительно текущей позиции отдельного указателя. Таким образом, для второго вызова, это относительно индивидуального указателя процесса 0

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

  • добавить дополнительный параметр saveMPI это будет содержать абсолютное смещение данных для записи; это может быть [in out] Arg. Для первого вызова это будет ноль, а для последующих вызовов это будет размер всех данных, уже записанных в файл, включая информацию о размере. Это может быть обновлено в saveMPI,
  • перед записью информации о размере (по процессу 0) вызовите MPI_File_set_view сбросить представление к линейному потоку байтов, как первоначально дано MPI_File_open, Это можно сделать, установив etype а также filetype как для MPI_BYTE в вызове MPI_File_set_view, заглянуть в документ MPI_File_open для дополнительной информации. Затем вам придется звонить MPI_File_set_view в saveMPI,

Ваш saveMPI подпрограмма может выглядеть как

subroutine saveMPI(array, n, disp)
    use mpi
    use arrays_dim
    use mpi_vars

    implicit none
    real(dp), dimension(n) :: array
    integer                   :: n, disp

    offset = (imax+1)*(jmax+2)*(kmax+2)*8
    call MPI_File_set_view(fileH, int(disp,MPI_OFFSET_KIND), MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr)
    if(myID==0) then
        call MPI_File_seek(fileH, int(0,MPI_OFFSET_KIND), MPI_SEEK_END, ierr)
        call MPI_File_write(fileH, [(imax+1)*(jmax+2)*(kmax+2)*8], 1, MPI_INTEGER, MPI_STATUS_IGNORE, ierr)
        call MPI_File_seek(fileH, int(offset,MPI_OFFSET_KIND), MPI_SEEK_CUR, ierr)
        call MPI_File_write(fileH, [(imax+1)*(jmax+2)*(kmax+2)*8], 1, MPI_INTEGER, MPI_STATUS_IGNORE, ierr)
    endif
    call MPI_File_set_view(fileH, int(disp+4,MPI_OFFSET_KIND), MPI_DOUBLE_PRECISION, subArray, 'native', MPI_INFO_NULL, ierr)
    call MPI_File_write_all(fileH, array, (i_loc)*(jmax+2)*(kmax+2), MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr)
    disp = disp+offset+8
end subroutine saveMPI

и называется как:

disp = 0
call saveMPI(v_loc, (i_loc)*(jmax+2)*(kmax+2), disp)
call saveMPI(w_loc, (i_loc)*(jmax+2)*(kmax+2), disp)

Наконец, убедитесь, что вы удаляете файл между двумя вызовами, потому что вы используете MPI_MODE_APPEND,

Другие вопросы по тегам