!===============================================================================
!
! copy_usc_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_usc_dd
  use typedef

  complex(8), dimension(:,:, :, :, :,:),pointer,save :: ddu
  complex(4), dimension(:,:, :, :, :,:),pointer,save :: ddu_r4

  complex(8), dimension(:, :, :, :, :), pointer, save :: sc2
  complex(4), dimension(:, :, :, :, :), pointer, save :: sc2_r4

  type(clover_field),    dimension(:,:),pointer,save :: clover_dd
  type(clover_field_r4), dimension(:,:),pointer,save :: clover_dd_r4

  integer :: mud(4), save

end

!-------------------------------------------------------------------------------
subroutine u2ddu(u)
  use module_usc_dd
  use module_nn
  use module_vol
  use module_lattice
  use module_dd
  implicit none
  GAUGE_FIELD :: u
  integer :: col, eo, oe, mu, i, j, di, de, dp

  if(.not. ddable) return

  do i = 1, volh
  do eo = EVEN, ODD
     oe = 1 - eo
     di = ddi( i,eo)
     de = ddeo(i,eo)
     dp = ddip(i,eo)

     do mu = 1, DIM
        j=nn(i,eo,mu,BWD)
        do col = 1, NCOL
           ddu(1, col, di, mu, de, dp) =       u(1, col, i, eo, mu)
           ddu(2, col, di, mu, de, dp) =       u(2, col, i, eo, mu)
           ddu(3, col, di, mu, de, dp) =       u(3, col, i, eo, mu)
           ddu(4, col, di, mu, de, dp) = conjg(u(col, 1, j, oe, mu))
           ddu(5, col, di, mu, de, dp) = conjg(u(col, 2, j, oe, mu))
           ddu(6, col, di, mu, de, dp) = conjg(u(col, 3, j, oe, mu))
           ddu_r4(1, col, di, mu, de, dp) =       u(1, col, i, eo, mu)
           ddu_r4(2, col, di, mu, de, dp) =       u(2, col, i, eo, mu)
           ddu_r4(3, col, di, mu, de, dp) =       u(3, col, i, eo, mu)
           ddu_r4(4, col, di, mu, de, dp) = conjg(u(col, 1, j, oe, mu))
           ddu_r4(5, col, di, mu, de, dp) = conjg(u(col, 2, j, oe, mu))
           ddu_r4(6, col, di, mu, de, dp) = conjg(u(col, 3, j, oe, mu))
        enddo
     enddo
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine sc2ddsc(ddsc, sc_e, sc_o)
  use module_vol
  use module_lattice
  use module_dd
  use module_action
  implicit none
  SPINCOL_FIELD :: sc_e, sc_o
  COMPLEX, dimension(12, ld%lat%volh, 0:ld%lat%num_ip-1,EVEN:ODD) :: ddsc
  integer :: eo, oe, i, j, di, de, dp

  if(.not. ddable) return

  !$omp parallel do private(di, de, dp)
  do i = 1, volh
     di = ddi( i,se)
     de = ddeo(i,se)
     dp = ddip(i,se)
     call copy_c12(ddsc(1,di,dp,de), sc_e(1,1, i))
  enddo

  !$omp parallel do private(di, de, dp)
  do i = 1, volh
     di = ddi( i,so)
     de = ddeo(i,so)
     dp = ddip(i,so)
     call copy_c12(ddsc(1,di,dp,de), sc_o(1,1, i))
  enddo
end

!-------------------------------------------------------------------------------
subroutine ddsc2sc(sc_e, sc_o, ddsc)
  use module_vol
  use module_lattice
  use module_dd
  use module_action
  implicit none
  SPINCOL_FIELD :: sc_e, sc_o
  COMPLEX, dimension(12, ld%lat%volh, 0:ld%lat%num_ip-1,EVEN:ODD) :: ddsc
  integer :: eo, oe, i, j, di, de, dp

  if(.not. ddable) return

  do i = 1, volh
     di = ddi( i,se)
     de = ddeo(i,se)
     dp = ddip(i,se)
     call copy_c12( sc_e(1,1, i),ddsc(1,di,dp,de))
  enddo

  do i = 1, volh
     di = ddi( i,so)
     de = ddeo(i,so)
     dp = ddip(i,so)
     call copy_c12( sc_o(1,1, i),ddsc(1,di,dp,de))
  enddo
end

!-------------------------------------------------------------------------------
subroutine clover2cloverdd(cid)
  use module_field
  use module_vol
  use module_dd
  use module_usc_dd
  implicit none
  integer :: eo, i, j, di, de, dp, cid

  if(.not. ddable) return

  do i = 1, volh
  do eo = EVEN, ODD
     di = ddi( i,eo)
     de = ddeo(i,eo)
     dp = ddip(i,eo)
     do j = 1, 2
        call type_clover_a_copy_r8(clover_dd(cid,dp)%a(j, di, de), clover(cid)%cfield%a(j, i, eo))
        call type_clover_b_copy_r8(clover_dd(cid,dp)%i(j, di, de), clover(cid)%cfield%i(j, i, eo))
        call type_clover_b_copy_r8(clover_dd(cid,dp)%b(j, di, de), clover(cid)%cfield%b(j, i, eo))
     enddo
  enddo
  enddo

  do i = 1, volh
  do eo = EVEN, ODD
     di = ddi( i,eo)
     de = ddeo(i,eo)
     dp = ddip(i,eo)
     do j = 1, 2
        call type_clover_a_copy_r8_to_r4(clover_dd_r4(cid,dp)%a(j, di, de),clover_dd(cid,dp)%a(j, di, de))
        call type_clover_b_copy_r8_to_r4(clover_dd_r4(cid,dp)%i(j, di, de),clover_dd(cid,dp)%i(j, di, de))
        call type_clover_b_copy_r8_to_r4(clover_dd_r4(cid,dp)%b(j, di, de),clover_dd(cid,dp)%b(j, di, de))
     enddo
  enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine init_usc_dd(volh, volh_tot, num_ip)
  use module_lattice
  use module_usc_dd
  use module_field
  use module_p_interface
  use module_dd
  use module_action
  implicit none
  integer :: volh, volh_tot, num_ip, cid, i, ip

  if(.not. ddable) return

  mud(1) = decomp_direction(1)
  mud(2) = decomp_direction(2)
  mud(3) = decomp_direction(3)
  mud(4) = decomp_direction(4)

  allocate(ddu(    6,NCOL, volh, DIM, EVEN:ODD, 0:num_ip-1))
  allocate(ddu_r4( 6,NCOL, volh, DIM, EVEN:ODD, 0:num_ip-1))

  allocate(sc2(   2, NCOL, volh_tot, DIM, FWD:BWD))
  allocate(sc2_r4(2, NCOL, volh_tot, DIM, FWD:BWD))

  if (size(clover) >0 ) then
     cid = n_clover_id
     nullify(clover_dd)
     nullify(clover_dd_r4)
     allocate(clover_dd(   cid,0:num_ip-1))
     allocate(clover_dd_r4(cid,0:num_ip-1))
     do i = 1, cid
     do ip= 0, num_ip-1
        nullify(clover_dd(   i,ip)%a)
        nullify(clover_dd(   i,ip)%i)
        nullify(clover_dd(   i,ip)%b)
        nullify(clover_dd_r4(i,ip)%a)
        nullify(clover_dd_r4(i,ip)%i)
        nullify(clover_dd_r4(i,ip)%b)
        allocate(clover_dd(   i,ip)%a(2,volh,EVEN:ODD))
        allocate(clover_dd(   i,ip)%i(2,volh,EVEN:ODD))
        allocate(clover_dd(   i,ip)%b(2,volh,EVEN:ODD))
        allocate(clover_dd_r4(i,ip)%a(2,volh,EVEN:ODD))
        allocate(clover_dd_r4(i,ip)%i(2,volh,EVEN:ODD))
        allocate(clover_dd_r4(i,ip)%b(2,volh,EVEN:ODD))
     enddo
     enddo
  endif
end
!-------------------------------------------------------------------------------
subroutine sc_realorder(out, in) 
  !!to keep results independent of the lattice decomposition of NPE
  !!since I use ran_gauss_volh to generate random sc field 
  use module_dd
  use module_vol
  use module_action
  implicit none
  complex(8), dimension (12,volh),intent(in) :: in
  complex(8), dimension (12,ld%lat%volh, 0:ld%lat%num_ip-1),intent(out) :: out
  integer :: i,di,dp

  if(.not. ddable) return
  do i = 1, volh
     di = ddi( i,se)
     dp = ddip(i,se)
     call copy_c12(out(1,di,dp), in(1,i))
  enddo
end
!-------------------------------------------------------------------------------
subroutine sc_reorder(out, in) 
  !!to keep results independent of the lattice decomposition of NPE
  !!since I use ran_gauss_volh to generate random sc field 
  use module_dd
  implicit none
  complex(8), dimension (12,ld%lat%volh, 0:1,gd%lat%volh),intent(in) :: in
  complex(8), dimension (12,ld%lat%volh, gd%lat%volh,0:1),intent(out):: out
  integer :: i,eo,idm

  if(.not. ddable) return
  do idm = 1, gd%lat%volh
  do eo =0,1
     do i = 1, ld%lat%volh
        call copy_c12(out(1, i,idm,eo),in(1,i,eo,idm))
     enddo
  enddo
  enddo

end

!===============================================================================
!===============================================================================
!
! this routine return SC field in domain of eo
!
!-------------------------------------------------------------------------------
subroutine ddsc_dcmp(out, in, eo)
  use module_dd
  implicit none
  complex(8), dimension(12, ld%lat%volh, 0:ld%lat%num_ip-1), intent(in) :: in
  complex(8), dimension(12, ld%lat%volh, gd%lat%volh), intent(out):: out
  integer :: eo, idm,i,mu,col

  if(.not. ddable) return
  do idm = 1, gd%lat%volh
     do i = 1, ld%lat%volh
        call copy_c12(out(1, i, idm ),in(1, i, my_dm(idm,eo)))
     enddo
  enddo
end
!-------------------------------------------------------------------------------
subroutine ddsc_undcmp(out, in, eo)
  use module_dd
  implicit none
  complex(8), dimension(12, ld%lat%volh, 0:ld%lat%num_ip-1), intent(inout) :: out
  complex(8), dimension(12, ld%lat%volh, gd%lat%volh), intent(in):: in
  integer :: eo, idm,i,mu,col

  if(.not. ddable) return
  do idm = 1, gd%lat%volh
     do i = 1, ld%lat%volh
        call copy_c12(out(1, i, my_dm(idm,eo)),in(1, i, idm ))
     enddo
  enddo
end
!-------------------------------------------------------------------------------
subroutine copy_c12(out, in)
  implicit none
  complex(8) :: out(12),in(12)
  integer :: i
  do i=1,12
     out(i)=in(i)
  enddo
end
!===============================================================================
!
! this routine return SC field in domain of eo
!
!-------------------------------------------------------------------------------
subroutine ddsc_dcmp_r4(out, in, eo)
  use module_dd
  implicit none
  complex(4), dimension(12, ld%lat%volh, 0:ld%lat%num_ip-1), intent(in) :: in
  complex(4), dimension(12, ld%lat%volh, gd%lat%volh), intent(out):: out
  integer :: eo, idm,i,mu,col

  if(.not. ddable) return
  do idm = 1, gd%lat%volh
     do i = 1, ld%lat%volh
        call copy_c12_r4(out(1, i, idm ),in(1, i, my_dm(idm,eo)))
     enddo
  enddo
end
!-------------------------------------------------------------------------------
subroutine ddsc_undcmp_r4(out, in, eo)
  use module_dd
  implicit none
  complex(4), dimension(12, ld%lat%volh, 0:ld%lat%num_ip-1), intent(inout) :: out
  complex(4), dimension(12, ld%lat%volh, gd%lat%volh), intent(in):: in
  integer :: eo, idm,i,mu,col

  if(.not. ddable) return
  do idm = 1, gd%lat%volh
     do i = 1, ld%lat%volh
        call copy_c12_r4(out(1, i, my_dm(idm,eo)),in(1, i, idm ))
     enddo
  enddo
end
!-------------------------------------------------------------------------------
subroutine copy_c12_r4(out, in)
  implicit none
  complex(4) :: out(12),in(12)
  integer :: i
  do i=1,12
     out(i)=in(i)
  enddo
end
