fortran - Variable 2D Array delivered to a variable number of nodes -

i have face situation:

given n number of mpi nodes , given 2d real array of [n_rows,n_cols] dimension

i have partition in order speed calculus, giving each node subsection of 2d array , taking advantage of number of nodes.

following fortran way store data in memory, arrays indexed using rapidly changing variable first, every [:,i]-column of array "logically" separated others.

i have looked around illuminating questions 1 sending 2d arrays in fortran mpi_gather

and have reached idea of using mpi_scatterv , mpi_gatherv, i'm stuck against fact that, since in problem constraints, there no possibility guarantee each mpi node given same amount of data, or, in pseudo code:

#number_of_mpi_nodes != n_rows*n_cols

i looking use vectors, since each "column" has own "independent" series of data, when "independent" mean have manipulation on data belonging same column, without affecting other columns.

obviously, since inequality given, mpi nodes have different number of "columns" analyze.

after doing math, need gather data, using mpi_gatherv

i update question working example in few hours!

thanks lot !

code:

program main  use mpi  implicit none  integer:: n_cols=100, n_rows=200 integer:: i, j integer:: id_mpi, com_mpi, error_mpi integer:: master = 0, size_mpi=0  integer:: to_each_cpu=0, to_each_cpu_oddment=0 integer:: sub_matrix_size=0  integer:: nans=0, infs=0, array_split =0, my_type=0  integer ,dimension(:), allocatable :: elem_to_each_cpu integer ,dimension(:), allocatable :: displacements integer,parameter:: seed = 12345  character*160:: message  real :: tot_sum = 0.0  real ,dimension(:,:), allocatable:: data_matrix real ,dimension(:,:), allocatable:: sub_split_data_matrix  call srand(seed)     call mpi_init(error_mpi) com_mpi = mpi_comm_world call mpi_comm_rank(com_mpi,id_mpi,error_mpi) call mpi_comm_size(com_mpi,size_mpi,error_mpi)  !! allocation data_matrix  = 1; j = 1 if (id_mpi .eq. master)     = n_rows; j = n_cols end if allocate(data_matrix(i, j))  j = 1, n_cols     = 1, n_rows         data_matrix(i, j) = rand()         tot_sum = tot_sum + data_matrix(i, j)     enddo enddo  write(message,*) "n_cols:",n_cols, "n_rows:", n_rows, " total_sum:", tot_sum write(*,*) message  !! since there no restrictions on mpi number or cpus or  !! size or data_matrix need  to_each_cpu =n_cols / size_mpi to_each_cpu_oddment = n_cols -( to_each_cpu * size_mpi )  allocate(elem_to_each_cpu(size_mpi)) elem_to_each_cpu = to_each_cpu allocate(displacements(size_mpi)) displacements = 0  !! choose split data in way if (id_mpi .eq. master)      write(message,*) "n_cols:",n_cols, "mpisize:", size_mpi, "to_each_cpu\oddment:", to_each_cpu, " \ ", to_each_cpu_oddment     write(*,*) message      j=1     = 1 , to_each_cpu_oddment         elem_to_each_cpu(j) = elem_to_each_cpu(j) + 1         j = j + 1         if(j .gt. size_mpi) j = 1     enddo      j = 2, size_mpi         displacements(j) = elem_to_each_cpu(j-1) + displacements(j-1)     enddo      = 1 , size_mpi         write(message,*)i, " to_each_cpu:", &         elem_to_each_cpu(i), " sub_split_buff_displ:",displacements(i), "=",elem_to_each_cpu(i)+displacements(i)         write(*,*) message     enddo  end if  call mpi_bcast(elem_to_each_cpu, size_mpi, mpi_int, 0, com_mpi, error_mpi) call mpi_bcast(displacements, size_mpi, mpi_int, 0, com_mpi, error_mpi)  allocate( sub_split_data_matrix(n_rows,elem_to_each_cpu(id_mpi+1)) )  call mpi_type_vector(n_cols,n_rows,n_rows,mpi_float,my_type,error_mpi)  call mpi_type_commit(my_type, error_mpi)   sub_split_data_matrix=0 sub_matrix_size = n_rows*elem_to_each_cpu(id_mpi+1)  call mpi_scatterv( data_matrix,elem_to_each_cpu,displacements,&     mpi_float, sub_split_data_matrix, sub_matrix_size ,mpi_float, &     0, com_mpi, error_mpi)  !!! doing math on scattered matrix   call mpi_gatherv(&     sub_split_data_matrix, sub_matrix_size,mpi_float ,&     data_matrix, elem_to_each_cpu, displacements, &     mpi_float, 0, com_mpi, error_mpi)  !!! doing math on gathered matrix  tot_sum = 0.0 j = 1, n_cols     = 1, n_rows         tot_sum = tot_sum + data_matrix(i, j)     enddo enddo  write(message,*) "n_cols:",n_cols, "n_rows:", n_rows, " total_sum:", tot_sum write(*,*) message   deallocate(data_matrix)  if (id_mpi .eq. master)     deallocate(elem_to_each_cpu )     deallocate(displacements ) endif  deallocate(sub_split_data_matrix)  end  

result:

error occurred in mpi_gahterv on communicator mpi_comm_world

invalid memory reference

question:

can me find error ? or better, can me in showing if approach used appropriate ?

thanks lot!

i had @ code , did changes fix it:

• unimportant: few stylistic / cosmetic elements here , there (from standpoint , arguable) improve readability. sorry if don't it.
• there no need process 0 1 computing lengths , displacements mpi_scatterv()/mpi_gatherv() calls. processes should compute them since have necessary data so. moreover, spares 2 mpi_bcast() good.
• the lengths strangely computed. suspect wrong i'm not sure since convoluted rewrote it.
• the main issue mix-up between vector type , scalar type: lengths , displacements computed vector type, calling mpi_scatterv()/mpi_gatherv() scalar type. moreover, fortran, scalar type mpi_real, not mpi_float. in code posted here-below, computed lengths , displacements mpi_real, if prefer, can divide them n_rows , use result of mpi_type_contiguous( n_rows, mpi_real, my_type ) instead of mpi_real in scatter/gather, , same result.

here modified code:

program main     use mpi     implicit none      integer, parameter :: n_cols=100, n_rows=200, master=0     integer :: i, j     integer :: id_mpi,size_mpi, com_mpi, error_mpi, my_type     integer :: to_each_cpu, to_each_cpu_oddment, sub_matrix_size      integer, allocatable :: elem_to_each_cpu(:), displacements(:)     real :: tot_sum = 0.0     real, allocatable :: data_matrix(:,:), sub_split_data_matrix(:,:)      call mpi_init( error_mpi )     com_mpi = mpi_comm_world     call mpi_comm_rank( com_mpi, id_mpi, error_mpi )     call mpi_comm_size( com_mpi, size_mpi, error_mpi )      !! allocation data_matrix      if ( id_mpi == master )         allocate( data_matrix( n_rows, n_cols ) )         call random_number( data_matrix )         j = 1, n_cols             = 1, n_rows                 tot_sum = tot_sum + data_matrix(i, j)             enddo         enddo         print *, "n_cols:", n_cols, "n_rows:", n_rows, " total_sum:", tot_sum     end if      !! since there no restrictions on mpi number or cpus or      !! size or data_matrix need      to_each_cpu = n_cols / size_mpi     to_each_cpu_oddment = n_cols - ( to_each_cpu * size_mpi )      allocate( elem_to_each_cpu(size_mpi) )     elem_to_each_cpu = to_each_cpu * n_rows     allocate( displacements(size_mpi) )     displacements = 0      !! choose split data in way     if ( id_mpi == master )         print *, "n_cols:", n_cols, "mpisize:", size_mpi, "to_each_cpu\oddment:", to_each_cpu, " \ ", to_each_cpu_oddment     end if       = 1, to_each_cpu_oddment        elem_to_each_cpu(i) = elem_to_each_cpu(i) + n_rows     enddo      = 1, size_mpi-1         displacements(i+1) = displacements(i) + elem_to_each_cpu(i)     enddo      if ( id_mpi == master )         = 1, size_mpi             print *, i, " to_each_cpu:", &                 elem_to_each_cpu(i), " sub_split_buff_displ:", displacements(i), &                 "=", elem_to_each_cpu(i) + displacements(i)         enddo     end if      allocate( sub_split_data_matrix(n_rows, elem_to_each_cpu(id_mpi+1)/n_rows) )      sub_split_data_matrix = 0     sub_matrix_size = elem_to_each_cpu(id_mpi+1)      call mpi_scatterv( data_matrix, elem_to_each_cpu ,displacements, mpi_real, &                        sub_split_data_matrix, sub_matrix_size, mpi_real, &                        master, com_mpi, error_mpi )      !!! doing math on scattered matrix       call mpi_gatherv( sub_split_data_matrix, sub_matrix_size, mpi_real, &                       data_matrix, elem_to_each_cpu, displacements, mpi_real, &                       master, com_mpi, error_mpi )      !!! doing math on gathered matrix      if ( id_mpi == master )         tot_sum = 0.0         j = 1, n_cols             = 1, n_rows                 tot_sum = tot_sum + data_matrix(i, j)             enddo         enddo          print *, "n_cols:", n_cols, "n_rows:", n_rows, " total_sum:", tot_sum         deallocate( data_matrix )     endif      deallocate( elem_to_each_cpu )     deallocate( displacements )     deallocate( sub_split_data_matrix )  end program main 

with these modifications, code works expected:

$ mpif90 scat_gath2.f90 $ mpirun -n 3 ./a.out   n_cols:         100 n_rows:         200  total_sum:   10004.4443      n_cols:         100 mpisize:           3 to_each_cpu\oddment:          33  \            1            1  to_each_cpu:        6800  sub_split_buff_displ:           0 =        6800            2  to_each_cpu:        6600  sub_split_buff_displ:        6800 =       13400            3  to_each_cpu:        6600  sub_split_buff_displ:       13400 =       20000  n_cols:         100 n_rows:         200  total_sum:   10004.4443