!===============================================================================
!
! clover_d.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-2006 Hinnerk Stueben
!               2008 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 clover_d_add(inout, u, in, eo)
  use module_vol
  implicit none

  GAUGE_FIELD, intent(inout) :: inout
  GAUGE_FIELD, intent(in)    :: u, in
  integer,     intent(in)    :: eo
!!  GAUGE_FIELD :: tmp
  COMPLEX, allocatable :: tmp(:, :, :, :, :)
  integer :: ierr

  DEBUG2S("START: clover_d_add")

  allocate(tmp(NCOL, NCOL, volh_tot, EVEN:ODD, DIM), STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("allocation failed", 1, ierr)
     call die("clover_d_add: allocation failed tmp")
  endif

  DEBUG2S("START: clover_d_add 1")

  call clover_d_w(tmp, u, in, eo)

  DEBUG2S("START: clover_d_add 2")

  inout(1:NCOL, 1:NCOL, 1:volh, 0:1, 1:DIM) = &
  inout(1:NCOL, 1:NCOL, 1:volh, 0:1, 1:DIM) + &
    tmp(1:NCOL, 1:NCOL, 1:volh, 0:1, 1:DIM)

  DEBUG2S("START: clover_d_add 3")
  deallocate(tmp,  STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("deallocation failed", 1, ierr)
     call die("clover_d_add: deallocation failed tmp")
  endif

  DEBUG2S("End: clover_d_add")

end

!-------------------------------------------------------------------------------
subroutine clover_d_w(out, u, in, eo)
  use module_vol
  use module_switches
  implicit none

  GAUGE_FIELD, intent(out) :: out
  GAUGE_FIELD, intent(in)  :: u, in
  integer,     intent(in)  :: eo
!!  GAUGE_FIELD :: inh
  COMPLEX, allocatable :: inh(:, :, :, :, :)
  integer :: i, mu, eo1, c1, c2, ierr

  COMPLEX :: i_times, c
  i_times(c) = cmplx(-aimag(c), real(c), kind = RKIND)

  TIMING_START(timing_bin_clover_d_w)
  DEBUG2S("START: clover_d_w")

  allocate(inh(NCOL, NCOL, volh_tot, EVEN:ODD, DIM), STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("allocation failed", 1, ierr)
     call die("clover_d_w: allocation failed inh")
  endif

  do mu = 1, 3
     !$omp parallel do
     do i = 1, volh
        call hermitian(inh(1, 1, i, EVEN, mu),in(1, 1, i, EVEN, mu))
     enddo
     !$omp parallel do
     do i = 1, volh
        call hermitian(inh(1, 1, i, ODD , mu),in(1, 1, i, ODD , mu))
     enddo
     call xbound_g(inh, EVEN, mu)
     call xbound_g(inh, ODD , mu)
  enddo
  if (switches%boundary_sf) call schr_boundary_zero4(inh)

  out = ZERO
  call clover_d_mu_nu_w(eo, 1, 2, out, u, inh(1, 1, 1, EVEN, 1))
  call clover_d_mu_nu_w(eo, 1, 3, out, u, inh(1, 1, 1, ODD,  1))
  call clover_d_mu_nu_w(eo, 1, 4, out, u, inh(1, 1, 1, EVEN, 2))
  call clover_d_mu_nu_w(eo, 2, 3, out, u, inh(1, 1, 1, ODD,  2))
  call clover_d_mu_nu_w(eo, 2, 4, out, u, inh(1, 1, 1, EVEN, 3))
  call clover_d_mu_nu_w(eo, 3, 4, out, u, inh(1, 1, 1, ODD,  3))

  do mu = 1, DIM
     do eo1 = EVEN, ODD
        !$omp parallel do private(c1, c2)
        do i = 1, volh
           do c1 = 1, NCOL
              do c2 = 1, NCOL
                 out(c1, c2, i, eo1, mu) = - i_times(out(c1, c2, i, eo1, mu))
              enddo
           enddo
        enddo
     enddo
  enddo

  if (switches%boundary_sf) call schr_boundary_zero3(out)

  deallocate(inh,  STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("deallocation failed", 1, ierr)
     call die("clover_d_w: deallocation failed inh")
  endif

  DEBUG2S("End: clover_d_w")
  TIMING_STOP(timing_bin_clover_d_w)

end

!-------------------------------------------------------------------------------
subroutine clover_d_mu_nu_w(e, mu, nu, w_out, u, w)
  use module_vol
  implicit none

  integer     :: e, o, mu, nu
  GAUGE_FIELD,intent(inout) :: w_out
  GAUGE_FIELD :: u
  SU3_FIELD   :: w
  external clover_d_same_eo_w, clover_d_diff_eo_w

  o = EVEN + ODD - e

  call clover_d_loop_w(e, o, mu, nu, w_out, u, w, clover_d_same_eo_w)
  call clover_d_loop_w(o, e, mu, nu, w_out, u, w, clover_d_diff_eo_w)

end

!-------------------------------------------------------------------------------
subroutine clover_d_loop_w(e, o, mu, nu, w_out, u, w, clover_dd_w)

  use module_vol
  use module_nn
  implicit none

  integer     :: e, o, mu, nu
  GAUGE_FIELD,intent(inout) :: w_out
  GAUGE_FIELD :: u
  SU3_FIELD   :: w
  SU3 :: tmp
  external clover_dd_w

  integer         :: i, ia, ib, ic, id, ie, if

#ifdef PATHSCALE
  !$omp parallel do private(ia, ib, ic, id, ie, if,tmp) shared(clover_dd_w)
#else
  !$omp parallel do private(ia, ib, ic, id, ie, if,tmp)
#endif
  do i = 1, volh

     id = nn(i, e, mu, FWD)
     ie = nn(i, e, nu, FWD)
     if = nn(i, e, nu, BWD)

     ia = i
     ib = nn(id, o, nu, FWD)
     ic = nn(id, o, nu, BWD)

     call clover_dd_w(tmp, &
                          u(1, 1, id, o, nu), &
                          u(1, 1, ie, o, mu), &
                          u(1, 1, ia, e, nu), &
                          u(1, 1, if, o, nu), &
                          u(1, 1, if, o, mu), &
                          u(1, 1, ic, e, nu), &
                          w(1, 1, ia), &
                          w(1, 1, ib), &
                          w(1, 1, ic), &
                          w(1, 1, id), &
                          w(1, 1, ie), &
                          w(1, 1, if))
     call u_add(w_out(1, 1, i, e, mu),tmp)
  enddo

!------------------- mu nu flip

#ifdef PATHSCALE
  !$omp parallel do private(ia, ib, ic, id, ie, if,tmp) shared(clover_dd_w)
#else
  !$omp parallel do private(ia, ib, ic, id, ie, if,tmp)
#endif
  do i = 1, volh

     id = nn(i, e, nu, FWD)
     ie = nn(i, e, mu, FWD)
     if = nn(i, e, mu, BWD)

     ia = i
     ib = nn(id, o, mu, FWD)
     ic = nn(id, o, mu, BWD)

     call clover_dd_w(tmp, &
                          u(1, 1, id, o, mu), &
                          u(1, 1, ie, o, nu), &
                          u(1, 1, ia, e, mu), &
                          u(1, 1, if, o, mu), &
                          u(1, 1, if, o, nu), &
                          u(1, 1, ic, e, mu), &
                          w(1, 1, ia), &
                          w(1, 1, ib), &
                          w(1, 1, ic), &
                          w(1, 1, id), &
                          w(1, 1, ie), &
                          w(1, 1, if))
     call u_sub(w_out(1, 1, i, e, nu),tmp)
  enddo

end

!-------------------------------------------------------------------------------
subroutine clover_d_same_eo_w(w, u1,u2,u3,u4,u5,u6, wa,wb,wc, wd,we,wf)
  implicit none
  SU3,intent(out) :: w
  SU3,intent(in)  :: u1, u2, u3, u4, u5, u6, wa, wb, wc, wd, we, wf

SU3 :: ww1,ww2,ww3,ww4
SU3 :: v1, v2

  call uu( v1, u3, u2)
  call udu(v2, u5, u4)

call udu(ww1,v1,wa)
call uud(ww2,wb,v1)
call uu(ww3,v2,wa)
call uu(ww4,wc,v2)

 ww1 = ww1 + ww2
 ww3 = ww3 + ww4

call uu( ww2,u1,ww1)
call udu(ww4,u6,ww3)

 w = ww2 - ww4

end

!-------------------------------------------------------------------------------
subroutine clover_d_diff_eo_w(w, u1,u2,u3,u4,u5,u6, wa,wb,wc, wd,we,wf)
  implicit none
  SU3,intent(out) :: w
  SU3,intent(in)  :: u1, u2, u3, u4, u5, u6, wa, wb, wc, wd, we, wf

SU3 :: uu12,uu56
SU3 :: ww1,ww2,ww3,ww4

call uud(uu12, u1, u2)
call uu( uu56, u5, u6)

call uu(ww1, wd, uu12)
call uu(ww2, uu12, we)

ww1 = ww1 + ww2

call uud(ww3,ww1,u3)

call uud(ww1,wd,uu56)
call udu(ww2,uu56,wf)

ww1 = ww1 + ww2

call uu(ww4,ww1,u4)

w = ww3 - ww4


end

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