!===============================================================================
!
! polyakov_loop_mpi.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2006 Hinnerk Stueben
!
! This file is part of BQCD -- Berlin Quantum ChromoDynamics program
!
! BQCD is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! BQCD is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with BQCD.  If not, see <http://www.gnu.org/licenses/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
module module_comm_polyakov_loop

  implicit none

  logical, save :: initialised = .false.
  integer, save :: bqcd_comm_polyakov  ! new MPI communicator
  integer, save :: bqcd_su3            ! new MPI datatype
  integer, save :: op_polyakov         ! new MPI operator
  
end

!-------------------------------------------------------------------------------
subroutine polyakov_loop_aggregate(pl, tmp_polyakov, nx, ny, nz)
  
  use module_decomp
  use module_comm_polyakov_loop
  use module_function_decl
  
  implicit none
  include 'mpif.h'
  
  COMPLEX, intent(out) :: pl 
  integer, intent(in)  :: nx, ny, nz
  COMPLEX, intent(in)  :: tmp_polyakov(NCOL, NCOL, 0:nx-1, 0:ny-1, 0:nz-1)
   
  SU3     :: tmp
  integer :: x, y, z
  integer :: newrank, ierror


  if (.not. initialised)  then
     call init_comm_polyakov_loop()
     initialised = .true.
  endif

  pl     = ZERO
  tmp    = ZERO
  
  do z = 0, nz - 1
     do y = 0, ny - 1
        do x = 0, nx - 1
	   call mpi_reduce(tmp_polyakov(1,1,x,y,z), tmp(1,1), 1, bqcd_su3, op_polyakov, &
                           0, bqcd_comm_polyakov, ierror)
           pl = pl + tmp(1,1) + tmp(2,2) + tmp(3,3)
	enddo
     enddo
  enddo
  

  ! to be safe that a proc not residing on the global_t = 0 timeslice has pl_local == 0
  ! (this call should be needless)

  call mpi_comm_rank(bqcd_comm_polyakov, newrank, ierror)

  if (newrank /= 0 .and. pl /= 0) then
     call die("polyakov_loop_aggregate(): pl_local /= 0, there must be a failure in the mpi_reduce call!") 
  endif
    
end

!-------------------------------------------------------------------------------
subroutine init_comm_polyakov_loop()

  use module_lattice
  use module_decomp
  use module_function_decl
  use module_vol
  use module_comm_polyakov_loop
  
  implicit none
  include 'mpif.h'
  
  integer           :: colour, key
  integer           :: newrank
  integer           :: ierror
  integer, external :: polyakov_loop_uu
  integer, external :: ilex
  logical           :: commute


  ASSERT(.not. initialised)

  ! build new communicator bqcd_comm_polyakov in t-direction

  colour = ilex(3, decomp%std%i_pe, decomp%std%NPE)
  key = decomp%std%i_pe(4)

  call mpi_comm_split(MPI_COMM_WORLD, colour, key, bqcd_comm_polyakov, ierror)
  

  ! check if the processors with global_t = 0 have rank 0 in terms of the new communicator bqcd_comm_polyakov 
  
  call mpi_comm_rank(bqcd_comm_polyakov, newrank, ierror)
  
  if ( newrank /= 0 .and. decomp%std%i_pe(4) == 0 ) then
     call die("init_polyakov_loop: new communicator bqcd_comm_polyakov is wrong!")
  endif  


  ! build new mpi_datatype bqcd_su3 for mpi_reduce()
 
  call mpi_type_contiguous(NCOL*NCOL*SIZE_COMPLEX, BQCD_REAL, bqcd_su3, ierror)
  call mpi_type_commit(bqcd_su3, ierror)

  
  ! build function for mpi_reduce
  
  commute = .false.
  call mpi_op_create(polyakov_loop_uu, commute, op_polyakov, ierror)
  

  call mpi_barrier(MPI_COMM_WORLD, ierror)
end

!-------------------------------------------------------------------------------
integer function polyakov_loop_uu(in, inout, len, type)

  implicit none
  SU3, intent(in)           :: in
  SU3, intent(inout)        :: inout
  integer, intent(in)       :: len, type

  integer                   :: i,j
  SU3                       :: temp
 
  do j = 1, NCOL
     do i = 1, NCOL
        temp(i, j) = in(i, 1) * inout(1, j) &
                   + in(i, 2) * inout(2, j) &
                   + in(i, 3) * inout(3, j)
     enddo
  enddo

  inout = temp
 
  polyakov_loop_uu = 1

end

!===============================================================================
