!===============================================================================
!
! init_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_dd()
  use module_input
  use module_lattice
  use module_dd
  use module_function_decl
  implicit none
  integer :: x,y,z,t,global(4),local(4), home,i,eo,mu,fb, iee
  integer,external :: xyzt2i_dd, e_o_gd
  logical :: ddtest

  DEBUG2S("Start: init_dd ")

  ddtest = .true.
  if (mod(ddlat(1), 2) /= 0) then
     call stderr2("init_dd(): ddlattice(1) must be even")
     ddtest=.false.
  endif

  if (mod(L(1),ddlat(1)) /= 0 ) then
     call stderr2("init_dd(): L(1) is not factor of LLD(1)"); ddtest=.false.
  endif
  if (mod(L(2),ddlat(2)) /= 0 ) then
     call stderr2("init_dd(): L(2) is not factor of LLD(2)"); ddtest=.false.
  endif
  if (mod(L(3),ddlat(3)) /= 0 ) then
     call stderr2("init_dd(): L(3) is not factor of LLD(3)"); ddtest=.false.
  endif
  if (mod(L(4),ddlat(4)) /= 0 ) then
     call stderr2("init_dd(): L(4) is not factor of LLD(4)"); ddtest=.false.
  endif
  if (mod(N(1),ddlat(1)) /= 0 ) then
     call stderr2("init_dd(): N(1) is not factor of LLD(1)"); ddtest=.false.
  endif
  if (mod(N(2),ddlat(2)) /= 0 ) then
     call stderr2("init_dd(): N(2) is not factor of LLD(2)"); ddtest=.false.
  endif
  if (mod(N(3),ddlat(3)) /= 0 ) then
     call stderr2("init_dd(): N(3) is not factor of LLD(3)"); ddtest=.false.
  endif
  if (mod(N(4),ddlat(4)) /= 0 ) then
     call stderr2("init_dd(): N(4) is not factor of LLD(4)"); ddtest=.false.
  endif

  if (mod(N(1)*N(2)*N(3)*N(4)/ddlat(1)/ddlat(2)/ddlat(3)/ddlat(4),2)/=0) then
     call stderr2("init_dd(): ODD number domain!!!"); ddtest=.false.
  endif

  if (.not. ddtest) then
     call stderr2("init_dd(): failed initialization for DD ")
     call stderr2("init_dd(): but ignore this if you do not use DD  ")
     DEBUG2S("Done: init_dd ")
     return
  else
     ddable = .true.
  endif

  ddallactive = (input%nonactivelink == 0)

  if (.not. ddallactive) call warn("nonactive link method does not work with stout link so far")

  call init_common_vol_dd(ld%lat,   N, N/ddlat)
  call init_common_vol_dd(gd%lat, L/ddlat, NPE)
  ld%lat%single = (NPE == 1 .and. N/ddlat == 1)
  gd%lat%single = (NPE == 1)

  call init_common_offset_dd(ld%lat)
  DEBUG2S("dd : allocate ldnn")
  allocate(ldnn(0:ld%lat%num_ip-1))
  do i = 0, ld%lat%num_ip - 1
     nullify(ldnn(i)%nn)
     nullify(ldnn(i)%nn2)
     nullify(ldnn(i)%count_dd)
     nullify(ldnn(i)%count_eo)
     nullify(ldnn(i)%volh_dd)
     nullify(ldnn(i)%volh_eo)
     nullify(ldnn(i)%proj_c)
     nullify(ldnn(i)%proj_i)
  DEBUG2S("dd : allocate ldnn ...")
     allocate(ldnn(i)%nn( ld%lat%volh_tot, EVEN:ODD, DIM, FWD:BWD))
     allocate(ldnn(i)%nn2(DIM, ld%lat%volh_tot, EVEN:ODD, FWD:BWD))
     allocate(ldnn(i)%count_dd(EVEN:ODD, DIM, FWD:BWD))
     allocate(ldnn(i)%count_eo(EVEN:ODD, DIM, FWD:BWD))
     allocate(ldnn(i)%volh_dd(ld%lat%volh, EVEN:ODD, DIM, FWD:BWD))
     allocate(ldnn(i)%volh_eo(ld%lat%volh, EVEN:ODD, DIM, FWD:BWD))
     allocate(ldnn(i)%proj_c(EVEN:ODD, 0:9))
     allocate(ldnn(i)%proj_i(ld%lat%volh, EVEN:ODD, 0:9))
  enddo
  do i = 0, ld%lat%num_ip - 1
!!     call init_common_nn_ld(i, ldnn(i)%nn, ldnn(i)%nn2)
     call init_common_nn_ld(i)
     call init_ddeo_count(ldnn(i))
  enddo

  call i2ddi()
  call init_common_nnpe_dd()

  DEBUG2S("dd : allocate i_dm ")
  allocate( i_dm(0:ld%lat%num_ip-1))

  DEBUG2S("dd : allocate eo_dm")
  allocate(eo_dm(0:ld%lat%num_ip-1))

  DEBUG2S("dd : allocate my_dm")
  allocate(my_dm(gd%lat%volh,0:1))

  DEBUG2S("dd : allocate i_dm eo_dm my_dm done")
  do i = 0, ld%lat%num_ip - 1
     call my_coord_dd(i, local, ld%lat) ! ld%lat is correct because ld%lat%ip is used
     i_dm(i)  = xyzt2i_dd(local,my_pe(),gd%lat)
     eo_dm(i) = e_o_gd(local)
     my_dm(i_dm(i),eo_dm(i))=i
  enddo

  DEBUG2S("init_dd : init_xbound_dd")
  call init_xbound_sc_dd(ld%lat%num_ip)
  call init_xbound_sc2_dd(ld%lat%num_ip)
  call init_xbound_sc2_dd_r4(ld%lat%num_ip)
  DEBUG2S("Done: init_dd ")
end
!-------------------------------------------------------------------------------
subroutine init_ddeo_count(nn)
  use module_function_decl
  use module_dd
  implicit none
  type(type_nn) :: nn
  integer :: i, mu, eo, out_count, dir

  nn%count_dd=0
  nn%count_eo=0
  nn%proj_c  =0

  do eo=EVEN, ODD
  do i = 1,ld%lat%volh
     out_count=0
     dir=0
     do mu=1,DIM
        if (nn%nn(i,eo,mu,FWD) <= ld%lat%volh)then
           nn%count_dd(eo,mu,FWD)=nn%count_dd(eo,mu,FWD)+1
           nn%volh_dd(nn%count_dd(eo,mu,FWD),eo,mu,FWD)=i
        else
           nn%count_eo(eo,mu,FWD)=nn%count_eo(eo,mu,FWD)+1
           nn%volh_eo(nn%count_eo(eo,mu,FWD),eo,mu,FWD)=i
           out_count=out_count+1
           dir=mu
        endif
        if (nn%nn(i,eo,mu,BWD) <= ld%lat%volh)then
           nn%count_dd(eo,mu,BWD)=nn%count_dd(eo,mu,BWD)+1
           nn%volh_dd(nn%count_dd(eo,mu,BWD),eo,mu,BWD)=i
        else
           nn%count_eo(eo,mu,BWD)=nn%count_eo(eo,mu,BWD)+1
           nn%volh_eo(nn%count_eo(eo,mu,BWD),eo,mu,BWD)=i
           out_count=out_count+1
           dir=4+mu
        endif
     enddo
     if (out_count>1) dir=9
     nn%proj_c(eo,dir) = nn%proj_c(eo,dir) + 1
     nn%proj_i(nn%proj_c(eo,dir),eo,dir)=i
  enddo
  enddo

!  do eo=0,1
!  do dir=0,9
!     write(0,*)eo,dir,nn%proj_c(eo,dir)
!     write(0,*)nn%proj_i(1:nn%proj_c(eo,dir),eo,dir)
!  enddo
!  enddo
!stop

#ifdef DEBUG2
if (my_pe()==0) then
write(0,*) nn%count_dd(0,1,FWD)+nn%count_dd(0,1,BWD)
write(0,*) nn%count_dd(0,2,FWD)+nn%count_dd(0,2,BWD)
write(0,*) nn%count_dd(0,3,FWD)+nn%count_dd(0,3,BWD)
write(0,*) nn%count_dd(0,4,FWD)+nn%count_dd(0,4,BWD)
write(0,*) nn%count_dd(1,1,FWD)+nn%count_dd(1,1,BWD)
write(0,*) nn%count_dd(1,2,FWD)+nn%count_dd(1,2,BWD)
write(0,*) nn%count_dd(1,3,FWD)+nn%count_dd(1,3,BWD)
write(0,*) nn%count_dd(1,4,FWD)+nn%count_dd(1,4,BWD)

write(0,*) nn%count_eo(0,1,FWD)+nn%count_eo(0,1,BWD)
write(0,*) nn%count_eo(0,2,FWD)+nn%count_eo(0,2,BWD)
write(0,*) nn%count_eo(0,3,FWD)+nn%count_eo(0,3,BWD)
write(0,*) nn%count_eo(0,4,FWD)+nn%count_eo(0,4,BWD)
write(0,*) nn%count_eo(1,1,FWD)+nn%count_eo(1,1,BWD)
write(0,*) nn%count_eo(1,2,FWD)+nn%count_eo(1,2,BWD)
write(0,*) nn%count_eo(1,3,FWD)+nn%count_eo(1,3,BWD)
write(0,*) nn%count_eo(1,4,FWD)+nn%count_eo(1,4,BWD)
endif
#endif

  do mu=1,DIM
     if (nn%count_eo(EVEN,mu,FWD)/=nn%count_eo(EVEN,mu,BWD)) call warn("init_ddeo_count: count_ef/=count_eb")
     if (nn%count_eo(EVEN,mu,FWD)/=nn%count_eo(ODD ,mu,FWD)) call warn("init_ddeo_count: count_ef/=count_of")
     if (nn%count_eo(EVEN,mu,FWD)/=nn%count_eo(ODD ,mu,BWD)) call warn("init_ddeo_count: count_ef/=count_ob")
  enddo

end

#ifndef NONMPI
!-------------------------------------------------------------------------------
subroutine mpi_testtest()
  use module_xbound_sc2_dd
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension(2, NCOL, ld%lat%volh_tot, DIM, FWD:BWD) :: a
  integer :: i,ip,mu,fb

  a=0

  do ip= 0, ld%lat%num_ip -1
  do mu=1,4
  do fb = FWD, BWD
     i = xbsc2(ip)%i_bound(mu, fb)
     if (i /= 0) then
     if (my_pe() /= xbsc2(ip)%b(i)%pe_target ) then
  write(0,*)"pe=",my_pe(),ip,i,fb,"mu=",mu, xbsc2(ip)%b(i)%pe_target,xbsc2(ip)%b(i)%pe_source
  call xbound_sc2_dd_mpi(a,xbsc2(ip)%b(i),mu,fb)
  write(0,*)"done mpicp"
     endif
     endif
  enddo
  enddo
  enddo

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