!===============================================================================
!
! xbound_dd.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2009-2010 Yoshifumi Nakamura
!
! 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_xbound_dd
  implicit none
# ifndef NONMPI
  include 'mpif.h'
# endif
!!  integer, parameter :: max_bound = 3 * 3 * 3 * 3
  integer, parameter :: max_bound = 8
  integer, parameter :: max_request = 2 * max_bound
  integer, save      :: request(max_request)
#ifndef NONMPI
  integer, save      :: status(MPI_STATUS_SIZE, max_request)
  integer, save      :: ierror
#endif

  type type_xbound_dd
     integer :: i_source
     integer :: i_target
     integer :: dm_source
     integer :: dm_target
     integer :: pe_source
     integer :: pe_target
     integer :: size        ! total size
     integer :: vector_type
     integer :: block_count
     integer :: block_size
     integer :: block_stride
  end type type_xbound_dd

end

!-------------------------------------------------------------------------------
module module_xbound_sc_dd
  use module_xbound_dd
  implicit none

  type type_xbound_sc_dd
     integer                 :: n_bound
     integer                 :: i_bound(DIM, FWD:BWD)
     type (type_xbound_dd)    :: b(max_bound)
  end type type_xbound_sc_dd

  type(type_xbound_sc_dd), dimension(:), pointer, save :: xbsc

end

!-------------------------------------------------------------------------------
module module_xbound_sc2_dd
  use module_xbound_dd
  implicit none

  type type_xbound_sc2_dd
     integer                 :: n_bound
     integer                 :: i_bound(DIM, FWD:BWD)
     type (type_xbound_dd)    :: b(max_bound)
  end type type_xbound_sc2_dd

  type(type_xbound_sc2_dd), dimension(:), pointer, save :: xbsc2

end

!-------------------------------------------------------------------------------
subroutine init_xbound_sc_dd(nip)
  use module_xbound_sc_dd
  implicit none
  integer, parameter :: block = NDIRAC * NCOL * SIZE_COMPLEX
  integer :: nip, i, mu, fb

  DEBUG2S("Start: init_xbound_sc_dd")
  allocate(xbsc(0:nip-1))
  xbsc(:)%n_bound = 0

  do i = 0, nip-1
  call init_xchb_ndiag_dd(xbsc(i)%n_bound, &
                                     xbsc(i)%b, block, &
                                     xbsc(i)%i_bound, i)
  enddo
  DEBUG2S("Done: init_xbound_sc_dd")
end

!-------------------------------------------------------------------------------
subroutine init_xbound_sc2_dd(nip)
  use module_xbound_sc2_dd
  implicit none
  integer, parameter :: block = 2 * NCOL * SIZE_COMPLEX
  integer :: nip, i, mu, fb

  DEBUG2S("Start: init_xbound_sc2_dd ")
  allocate(xbsc2(0:nip-1))
  DEBUG2S("init_xbound_sc2_dd allocation done")
  xbsc2(:)%n_bound = 0

  do i = 0, nip-1
  call init_xchb_ndiag_dd(xbsc2(i)%n_bound, &
                                     xbsc2(i)%b, block, &
                                     xbsc2(i)%i_bound, i)
  enddo
  DEBUG2S("Done: init_xbound_sc2_dd")
end

!-------------------------------------------------------------------------------
subroutine init_xch_bound_dd(n_bound, b, block_size, xx, yy, zz, tt  ,myip)

  use      module_xbound_dd
  use      module_dd
  use module_nnpe
  use module_function_decl
  implicit none

  integer, intent(inout)            :: n_bound
  type (type_xbound_dd), intent(inout) :: b(max_bound)
  integer, intent(in)               :: block_size, xx, yy, zz, tt

  integer, dimension (DIM) :: dir, m, i, target, source, coord1, coord2, jj
  integer, external        :: xyzt2i_dd, n_sites_dd
  integer                  :: x, y, z, t, size, mu, stride, block_count
  integer                  :: the_type, myip
  logical :: otherpe


!write(*,222)"ld%nndm%dm",xx,yy,zz,tt,ld%nndm(xx, yy, zz, tt, myip)%dm,myip,my_pe()
!write(*,222)"ld%nndm%pe",xx,yy,zz,tt,ld%nndm(xx, yy, zz, tt, myip)%pe,myip,my_pe()

!222 format  (a,7i4)

  if (ldnndm(xx, yy, zz, tt, myip)%dm == myip .and. &
      ldnndm(xx, yy, zz, tt, myip)%pe == my_pe()) return

  otherpe = (ldnndm(xx, yy, zz, tt, myip)%pe /= my_pe())

  dir = (/ xx, yy, zz, tt /)

  do mu = 1, DIM
     if (dir(mu) /= 0) then
        m(mu) = 1
     else
        m(mu) = ld%lat%nh(mu)
     endif

     if (dir(mu) == -1) then
        target(mu) = -1
        source(mu) = ld%lat%n(mu) - 1
     elseif (dir(mu) == +1) then
        target(mu) = ld%lat%n(mu)
        source(mu) = 0
     else
        target(mu) = 0
        source(mu) = 0
     endif
  enddo


  size = block_size
  do mu = 1, DIM
     if (dir(mu) == 0) then
        size = size * ld%lat%nh(mu)
        m(mu) = 1
     else
        exit
     endif
  enddo

  stride = block_size
  do mu = 1, DIM
     if (m(mu) == 1) then
        stride = stride * ld%lat%nh(mu)
     else
        exit
     endif
  enddo

  block_count = 1
  do mu = 1, DIM
     block_count = block_count * m(mu)
  enddo

  n_bound = n_bound + 1
  ASSERT(n_bound <= max_bound)
#ifndef NONMPI
  the_type = BQCD_REAL
#endif
  b(n_bound)%size = block_count * size

  b(n_bound)%i_source  = xyzt2i_dd(source,myip,ld%lat)
  b(n_bound)%i_target  = xyzt2i_dd(target,myip,ld%lat)

  b(n_bound)%dm_source = ldnndm( xx,  yy,  zz,  tt, myip)%dm
  b(n_bound)%dm_target = 200000000

  call my_coord_dd(myip,                        coord1,ld%lat)
  call my_coord_dd(ldnndm(xx,yy,zz,tt,myip)%dm,coord2,ld%lat)
  jj = (/ xx, yy, zz, tt /)
  do mu = 1, DIM
     if ( coord1(mu) + jj(mu) == coord2(mu)) jj(mu)=0
  enddo

  b(n_bound)%pe_source = nnpe( jj(1), jj(2), jj(3), jj(4))
  b(n_bound)%pe_target = nnpe(-jj(1),-jj(2),-jj(3),-jj(4))

  b(n_bound)%block_count = block_count
  b(n_bound)%block_size  = size
  b(n_bound)%block_stride= stride

#ifndef NONMPI

  DEBUG2S("now try mpi_type_vector")

  call mpi_type_vector(block_count, size, stride, the_type, &
                       b(n_bound)%vector_type, ierror)
  if (ierror /= 0)call die("mpi_type_vector // ierror")
  DEBUG2S("mpi_type_vector done!")

  DEBUG2S("now try mpi_type_commit")
  call mpi_type_commit(b(n_bound)%vector_type, ierror)
  if (ierror /= 0)call die("mpi_type_commit // ierror")
  DEBUG2S("mpi_type_commit done!")
#endif

  if (otherpe) then
  ASSERT(b(n_bound)%size == block_size * n_sites_dd(DIM, dir, ld%lat%nh, gd%lat%single))
  else
  ASSERT(b(n_bound)%size == block_size * n_sites_dd(DIM, dir, ld%lat%nh, ld%lat%single))
  endif

end

!-------------------------------------------------------------------------------
subroutine init_xchb_ndiag_dd(n_bound, b, block, i_bound, myip)
  use module_xbound_dd
  use module_dd
  implicit none

  integer            :: n_bound
  type (type_xbound_dd) :: b(max_bound)
  integer            :: block
  integer            :: i_bound(DIM, FWD:BWD)

  integer            :: mu, myip

  call init_xch_bound_dd(n_bound, b, block, -1,0,0,0, myip);  i_bound(1, BWD) = n_bound
  call init_xch_bound_dd(n_bound, b, block, +1,0,0,0, myip);  i_bound(1, FWD) = n_bound
  call init_xch_bound_dd(n_bound, b, block, 0,-1,0,0, myip);  i_bound(2, BWD) = n_bound
  call init_xch_bound_dd(n_bound, b, block, 0,+1,0,0, myip);  i_bound(2, FWD) = n_bound
  call init_xch_bound_dd(n_bound, b, block, 0,0,-1,0, myip);  i_bound(3, BWD) = n_bound
  call init_xch_bound_dd(n_bound, b, block, 0,0,+1,0, myip);  i_bound(3, FWD) = n_bound
  call init_xch_bound_dd(n_bound, b, block, 0,0,0,-1, myip);  i_bound(4, BWD) = n_bound
  call init_xch_bound_dd(n_bound, b, block, 0,0,0,+1, myip);  i_bound(4, FWD) = n_bound

  do mu = 1, DIM
     if (ld%lat%single(mu)) then
        i_bound(mu, FWD) = 0
        i_bound(mu, BWD) = 0
     endif
  enddo

end

!-------------------------------------------------------------------------------
subroutine xbound_sc2_dd_cp(count,size,stride,out,in)

  implicit none
  integer,intent(in) :: count,size,stride
  REAL,intent(out) :: out(size, count*(stride/size ) ) 
  REAL,intent(in)  ::  in(size, count*(stride/size ) )
  integer :: is, ic, add


  do ic=1,count
     add= 1 + stride/size * (ic-1)
     do is=1,size
        out(is,ic) = in(is,add)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
#ifndef NONMPI
subroutine xbound_sc_dd_mpi(a,b)
  use module_xbound_dd
  use module_dd
  implicit none
  type(type_xbound_dd), intent(in) :: b
  COMPLEX, dimension(NDIRAC, NCOL, ld%lat%volh_tot), intent(inout) :: a

   call mpi_sendrecv( &
   a(1,1, b%i_source), 1, b%vector_type,  b%pe_target, 0,&
   a(1,1, b%i_target), b%size, BQCD_REAL, b%pe_source, 0,&
   MPI_COMM_WORLD, status, ierror)

end

!-------------------------------------------------------------------------------
subroutine xbound_sc2_dd_mpi(a,b,mu,fb)
  use module_xbound_dd
  use module_dd
  implicit none
  type(type_xbound_dd), intent(in) :: b
  COMPLEX, dimension(2, NCOL, ld%lat%volh_tot, DIM, FWD:BWD), intent(inout) :: a
  integer :: mu, fb

   call mpi_sendrecv( &
   a(1,1, b%i_source, mu,fb), 1, b%vector_type,  b%pe_target, 0,&
   a(1,1, b%i_target, mu,fb), b%size, BQCD_REAL, b%pe_source, 0,&
   MPI_COMM_WORLD, status, ierror)

end
#endif
!===============================================================================
