Я пытаюсь понять некоторые аспекты ввода / вывода MPI.Следующий тестовый код предназначен для заполнения локальных массивов четырех процессов, каждый из которых является частью большого массива 10x10, а затем выводится в файл, так что весь массив записывается в правильном порядке.Вы можете заметить, что четыре процесса обладают прямоугольными частями массива, и вместе они точно покрывают область большого массива, но их границы не «возводятся в квадрат» друг с другом.Это сделано намеренно.
Вы заметите, что там, где на самом деле происходит запись, у меня есть два варианта.Первый создает файл, заполненный некоторыми правильными значениями попадания или пропуска, но в основном это тарабарщина.Второй вариант работает отлично.Я ожидал, что первый вариант сработает.Что я не понимаю о mpi_file_write()?
module mpi_stuff
use mpi
integer :: err_mpi
integer :: stat_mpi(MPI_STATUS_SIZE)
integer :: numprocs, myrank
integer :: output_type
integer :: outfile
integer :: starts(2)
end module mpi_stuff
module mydata
! ll: lower left x and y of local array
! uu: upper right x and y of local array
! arrsize : dimensions of local array
integer :: ll(2), uu(2), arrsize(2)
integer, allocatable :: lcl_data(:,:)
end module mydata
program output_test
use mpi_stuff
use mydata
! init MPI. get rank and size of comm
call mpi_init(err_mpi)
call mpi_comm_size(MPI_COMM_WORLD, numprocs, err_mpi)
call mpi_comm_rank(MPI_COMM_WORLD, myrank, err_mpi)
! initialize data
call data_init()
! define output types
print *,'proc ',myrank,' about to create'
call flush(6)
call mpi_type_create_subarray(2, (/10,10/), arrsize, starts, MPI_ORDER_FORTRAN, &
MPI_INTEGER, output_type, err_mpi)
call mpi_type_commit(output_type, err_mpi)
! open file
call mpi_file_open(MPI_COMM_WORLD, 'output.mpi', &
MPI_MODE_CREATE+MPI_MODE_RDWR, &
MPI_INFO_NULL, outfile, err_mpi)
! write to file
! option 1 -- FAILS MISERABLY!
!call mpi_file_write(outfile, lcl_data, 1, output_type, stat_mpi, err_mpi)
! option 2 -- WORKS PERFECTLY!
call mpi_file_set_view(outfile, 0, MPI_INTEGER, output_type, "native", MPI_INFO_NULL, err_mpi)
call mpi_file_write(outfile, lcl_data, arrsize(1)*arrsize(2), MPI_INTEGER, stat_mpi, err_mpi)
! clean up
call mpi_file_close(outfile, err_mpi)
call mpi_type_free(output_type, err_mpi)
call mpi_finalize(err_mpi)
end program output_test
subroutine data_init()
use mpi_stuff
use mydata
integer :: glbj, glbi, gval
select case(myrank)
case(0)
ll = (/1,1/)
uu = (/4,3/)
case(1)
ll = (/1,4/)
uu = (/4,10/)
case(2)
ll = (/5,1/)
uu = (/10,7/)
case(3)
ll = (/5,8/)
uu = (/10,10/)
end select
arrsize(1) = uu(1)-ll(1)+1
arrsize(2) = uu(2)-ll(2)+1
starts = ll - 1
print *,myrank,": ", ll, uu, starts, arrsize
allocate(lcl_data(arrsize(1), arrsize(2)))
do j = 1, arrsize(2)
glbj = j + ll(2) - 1
do i = 1, arrsize(1)
glbi = i + ll(1) - 1
gval = (glbi-1) + 10*(glbj-1)
lcl_data(i,j) = gval
enddo
enddo
print *,myrank,': ',lcl_data
end subroutine data_init