program trasposta

  implicit none
  include "mpif.h"
  
  integer, parameter :: dim = 8 
  integer :: ierr, mype, nprocs
  integer :: k, j, i, count, numRow, sup
  integer, dimension(:,:), allocatable :: mat, buf

  call MPI_Init(ierr)
  call MPI_Comm_size(MPI_COMM_WORLD, nprocs, ierr)
  call MPI_Comm_rank(MPI_COMM_WORLD, mype, ierr)

  numRow = dim/nprocs

  allocate(mat(numRow, dim))
  allocate(buf(numRow, dim))

  do j=1, dim
     do i=1, numRow
         mat(i,j)= 1000*(i+mype*numRow)+j
    end do
  end do

! print matrix 
  if(mype.eq.0) then
     print*, "Original matrix"
  end if
  
  do count=0, nprocs-1 
     call MPI_Barrier(MPI_COMM_WORLD, ierr)
     if(mype.eq.count)then
        do i=1, numRow
           print*, mat(i,:)
        end do
     end if
     call MPI_Barrier(MPI_COMM_WORLD, ierr)      
  end do
  
  call MPI_Alltoall(mat, numRow*numRow, MPI_INTEGER, buf, numRow*numRow, MPI_INTEGER, MPI_COMM_WORLD, ierr) 
  mat = buf
  
  do k=1, nprocs
     do j=1, numRow
        do i=1,j-1
           sup=mat(i,((k-1)*numRow)+j);
           mat(i,((k-1)*numRow)+j)=mat(j,((k-1)*numRow)+i);
           mat(j,((k-1)*numRow)+i)=sup;
        end do
     end do
  end do
  
! print transpose
  if(mype.eq.0) then
     print*, "Transpose matrix"
  end if
  
  do count=0, nprocs-1 
     call MPI_Barrier(MPI_COMM_WORLD, ierr)
     if(mype.eq.count)then
        do i=1, numRow
           print*, mat(i,:)
        end do
     end if
     call MPI_Barrier(MPI_COMM_WORLD, ierr)
  end do
  
  deallocate(mat)
  
  call MPI_Finalize(ierr)
  
end program trasposta
