!===============================================================================
!
! init_common_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"

!-------------------------------------------------------------------------------
!!subroutine init_common_nn_ld(me, nn, nn2)
subroutine init_common_nn_ld(me)
  use module_lattice
  use module_dd
  implicit none
  integer :: x, y, z, t, i, eo, mu, fb, dir, tmp, me
  integer, dimension (DIM) :: j, start, end
  integer, external :: e_o_ld, xyzt2i_dd, i_periodic
  integer(4), parameter :: out_of_range = 2000000000
!!  INTEGER,intent(out) :: nn(ld%lat%volh_tot, EVEN:ODD, DIM, FWD:BWD)
!!  INTEGER,intent(out) :: nn2(DIM, ld%lat%volh_tot, EVEN:ODD, FWD:BWD)

  do fb = FWD, BWD
     do mu = 1, DIM
        do eo = EVEN, ODD
           !$omp parallel do
           do i = 1, ld%lat%volh_tot
              ldnn(me)%nn(i, eo, mu, fb) = out_of_range
           enddo
        enddo
     enddo
  enddo

  do mu = 1, DIM
     if (ld%lat%single(mu)) then
        start(mu) = 0
        end(mu) = ld%lat%n(mu) - 1
     else
        start(mu) = -1
        end(mu) = ld%lat%n(mu)
     endif
  enddo

  do t = start(4), end(4)
  do z = start(3), end(3)
  do y = start(2), end(2)
  do x = start(1), end(1)

     j = (/x,y,z,t/)
     i = xyzt2i_dd(j,me,ld%lat)
!!     eo = e_o_dd(j,  me,ld%lat)
     eo = e_o_ld(j,  me)
     do fb = FWD, BWD
        if (fb == FWD) then
           dir = +1
        else
           dir = -1
        endif
        do mu = 1, DIM
           j = (/x, y, z, t/)
           j(mu) = j(mu) + dir

           if (ld%lat%single(mu)) j(mu) = i_periodic(j(mu), ld%lat%l(mu))

           if (j(mu) < -1 .or. j(mu) > ld%lat%n(mu)) then
              ldnn(me)%nn(i, eo, gamma_index(mu), fb) = out_of_range
           else
              ldnn(me)%nn(i, eo, gamma_index(mu), fb) = xyzt2i_dd(j,me,ld%lat)
           endif
        enddo
     enddo

  enddo
  enddo
  enddo
  enddo

  do fb = FWD, BWD
     do mu = 1, DIM
        do eo = EVEN, ODD
           do i = 1, ld%lat%volh
              tmp = ldnn(me)%nn(i, eo, mu, fb)
              ASSERT(tmp >= 1 .and. tmp <= ld%lat%volh_tot)
              ASSERT(.not. (ld%lat%num_ip == 1 .and. tmp > ld%lat%volh))
           enddo
        enddo
     enddo
  enddo

  do fb = FWD, BWD
     do mu = 1, DIM
        do eo = EVEN, ODD
           do i = 1, ld%lat%volh
              tmp = ldnn(me)%nn(i, eo, mu, fb)
              ASSERT(ldnn(me)%nn(tmp, EVEN + ODD - eo, mu, FWD + BWD - fb) == i)
           enddo
        enddo
     enddo
  enddo

  do fb = FWD, BWD
     do mu = 1, DIM
        do eo = EVEN, ODD
           do i = 1, ld%lat%volh_tot
              ldnn(me)%nn2(mu, i, eo, fb) = ldnn(me)%nn(i, eo, mu, fb)
           enddo
        enddo
     enddo
  enddo
end

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
subroutine init_common_nnpe_dd()
  use module_function_decl
  use module_dd
  use module_nnpe
  implicit none

  integer, dimension (DIM) :: i, j, jj, start, end, coord
  integer, external :: i_periodic, coord2pe_dd
  integer :: me, pe, x, y, z, t, mu

  allocate(ldnndm(-1:1, -1:1, -1:1, -1:1, 0:ld%lat%num_ip-1))

  do me = 0, ld%lat%num_ip -1 
     ldnndm(-1:1, -1:1, -1:1, -1:1, me)%dm = me

     call my_coord_dd(me, i, ld%lat)

     do mu = 1, DIM
        if (ld%lat%single(mu)) then
           start(mu) = 0
           end(mu) = 0
        else
           start(mu) = -1
           end(mu) = 1
        endif
     enddo

     do t = start(4), end(4)
     do z = start(3), end(3)
     do y = start(2), end(2)
     do x = start(1), end(1)

        j(1) = i_periodic(i(1) + x, ld%lat%ip(1))
        j(2) = i_periodic(i(2) + y, ld%lat%ip(2))
        j(3) = i_periodic(i(3) + z, ld%lat%ip(3))
        j(4) = i_periodic(i(4) + t, ld%lat%ip(4))

        pe = coord2pe_dd(j,ld%lat)

        ASSERT(pe >= 0 .and. pe < ld%lat%num_ip)

        ldnndm(x, y, z, t, me)%dm = pe

     enddo
     enddo
     enddo
     enddo
     ASSERT(ldnndm(0,0,0,0,me)%dm == me)
  enddo

  do me = 0, ld%lat%num_ip -1 
     ldnndm(-1:1, -1:1, -1:1, -1:1, me)%pe = my_pe()

     call my_coord_dd(me, i, ld%lat)

     do mu = 1, DIM
        if (gd%lat%single(mu)) then
           start(mu) = 0
           end(mu) = 0
        else
           start(mu) = -1
           end(mu) = 1
        endif
     enddo

     do t = start(4), end(4)
     do z = start(3), end(3)
     do y = start(2), end(2)
     do x = start(1), end(1)
        call my_coord_dd(ldnndm(x, y, z, t, me)%dm,coord,ld%lat)
        jj=0
        if ( i(1) + x /= coord(1)) jj(1)=x
        if ( i(2) + y /= coord(2)) jj(2)=y
        if ( i(3) + z /= coord(3)) jj(3)=z
        if ( i(4) + t /= coord(4)) jj(4)=t
        ldnndm(x, y, z, t, me)%pe = nnpe(jj(1), jj(2), jj(3), jj(4))
!write(0,100)"jj",my_pe(),ldnndm(x, y, z, t, me)%pe, &
!               "(",jj      ,")", &
!               "(",i       ,")", &
!               "(",x,y,z,t ,")", &
!               "(",coord   ,")"
     enddo
     enddo
     enddo
     enddo
100 format (a2, 2i3,1x, 4(a1,4i3,1x,a1))
     ASSERT(ldnndm(0,0,0,0,me)%pe == my_pe())
  enddo
end

!-------------------------------------------------------------------------------
subroutine init_common_offset_dd(ddtype)

  use module_dd
  implicit none
  type(ddlatvol) :: ddtype
  integer, external :: n_sites_dd
  integer :: x, y, z, t, off, off2, mu
  integer :: start(DIM), end(DIM)


  ASSERT(n_sites_dd(DIM, (/0,0,0,0/), ddtype%n,  ddtype%single) == ddtype%vol)
  ASSERT(n_sites_dd(DIM, (/0,0,0,0/), ddtype%nh, ddtype%single) == ddtype%volh)

  do mu = 1, DIM
     if (ddtype%single(mu)) then
        start(mu) = 0
        end(mu) = 0
     else
        start(mu) = -1
        end(mu) = 1
     endif
  enddo

  off = n_sites_dd(DIM,(/0,0,0,0/), ddtype%nh, ddtype%single)  ! volh

  do t = start(4), end(4)
  do z = start(3), end(3)
  do y = start(2), end(2)
  do x = start(1), end(1)

     if (x == 0 .and. y == 0 .and. z == 0 .and. t == 0) then
        ddtype%offset(x,y,z,t) = 0
     else
        ddtype%offset(x,y,z,t) = off
        off = off + n_sites_dd(DIM, (/x,y,z,t/), ddtype%nh, ddtype%single)
     endif

  enddo
  enddo
  enddo
  enddo

  off2 = 1
  do mu = 1, DIM
     if (ddtype%single(mu)) then
        off2 = off2 * ddtype%nh(mu)
     else
        off2 = off2 * (ddtype%nh(mu) + 2)
     endif
  enddo

  ASSERT(off == off2)
  ASSERT(off <= ddtype%volh_tot)

end
!-------------------------------------------------------------------------------
subroutine init_common_vol_dd(out, ll, nn)
  use module_dd
  implicit none
  type(ddlatvol) :: out
  integer, dimension(DIM), intent(in) :: ll, nn

  out%num_ip = nn(1)*nn(2)*nn(3)*nn(4)
  out%ip= nn
  out%l = ll
  out%n = ll / nn  
  out%nh=out%n
  out%nh(1)=out%nh(1)/2
  out%volume   = out%l(1) * out%l(2) * out%l(3) * out%l(4)
  out%vol      = out%n(1) * out%n(2) * out%n(3) * out%n(4)
  out%volh     = out%vol / 2
  out%volh_tot = (out%n(1)/2 + 2) * (out%n(2) + 2) &
               * (out%n(3) + 2) * (out%n(4) + 2)
end
!===============================================================================
