!===============================================================================
!
! clover_dsd.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C)  1998-2003 Hinnerk Stueben
!                2007-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_dsd_w(eob, w_add, cid, s, t)
  use typedef_clover
  use module_vol
  use module_field
  use module_action
  implicit none

  GAUGE_FIELD, intent(inout) :: w_add
  COMPLEX, dimension(NDIRAC, NDIRAC, NCOL, NCOL, volh), intent(out) :: t
  integer, intent(in) :: eob, cid    ! eob is EVEN/ODD property of "b"
  REAL,intent(in) :: s
  integer :: i, eo, mu, col1, col2, s1, s2
  COMPLEX, allocatable :: w(:, :, :, :, :)

  external :: sproj2_sigma_12   , sproj2_sigma_21
  external :: sproj2_sigma_31   , sproj2_sigma_13
  external :: sproj2_sigma_41_nr, sproj2_sigma_14_nr, sproj2_sigma_41_ch, sproj2_sigma_14_ch
  external :: sproj2_sigma_23   , sproj2_sigma_32
  external :: sproj2_sigma_24_nr, sproj2_sigma_24_ch, sproj2_sigma_42_nr, sproj2_sigma_42_ch
  external :: sproj2_sigma_43_nr, sproj2_sigma_34_nr, sproj2_sigma_43_ch, sproj2_sigma_34_ch

  SPINCOL_FIELD  :: x, y

  TIMING_START(timing_bin_clover_dsd_w)
  DEBUG2S("Start: clover_dsd_w")

  allocate(w(NCOL, NCOL, volh_tot, EVEN:ODD, DIM))
!!  allocate(t(NDIRAC, NDIRAC, NCOL, NCOL, volh))

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
  do col2 = 1, NCOL
     do s2 = 1, NDIRAC
        x = ZERO
        !$omp parallel do
        do i = 1, volh
           x(s2, col2, i) = ONE
        enddo
#ifdef FLIPSC
        call scfield_reorder_43_to_34(x)
#endif
        call clover_inv_mult(x, cid, eob)
#ifdef FLIPSC
        call scfield_reorder_34_to_43(x)
#endif
	!$omp parallel do private(col1, s1)
        do i = 1, volh
           do col1 = 1, NCOL
              do s1 = 1, NDIRAC
                 t(s1, s2, col1, col2, i) = x(s1, col1, i)
              enddo
           enddo
        enddo
     enddo
  enddo
  else
  do col2 = 1, NCOL
     do s2 = 1, NDIRAC
        x = ZERO
        y = ZERO
        !$omp parallel do
        do i = 1, volh
           x(s2, col2, i) = HALF
           y(s2, col2, i) = HALF
        enddo
#ifdef FLIPSC
        call scfield_reorder_43_to_34(x)
        call scfield_reorder_43_to_34(y)
#endif
        call clover_inv_mult(x, cid, eob)
        call clover_dag_inv_mult(y, cid, eob)
#ifdef FLIPSC
        call scfield_reorder_34_to_43(x)
        call scfield_reorder_34_to_43(y)
#endif
	!$omp parallel do private(col1, s1)
        do i = 1, volh
           do col1 = 1, NCOL
              do s1 = 1, NDIRAC
                 t(s1, s2, col1, col2, i) = x(s1, col1, i) + y(s1, col1, i)
              enddo
           enddo
        enddo
     enddo
  enddo
  endif

#ifdef GAMMA_NOTATION_CHROMA
  call clovervv(w(1, 1, 1, EVEN, 1), t, sproj2_sigma_21   )
  call clovervv(w(1, 1, 1, ODD,  1), t, sproj2_sigma_31   )   ! <- 13
  call clovervv(w(1, 1, 1, EVEN, 2), t, sproj2_sigma_41_ch)
  call clovervv(w(1, 1, 1, ODD,  2), t, sproj2_sigma_32   )
  call clovervv(w(1, 1, 1, EVEN, 3), t, sproj2_sigma_42_ch)   ! <- 24 !s
  call clovervv(w(1, 1, 1, ODD,  3), t, sproj2_sigma_43_ch)           !s
#elif defined GAMMA_NOTATION_CHIRAL
  call clovervv(w(1, 1, 1, EVEN, 1), t, sproj2_sigma_12   )
  call clovervv(w(1, 1, 1, ODD,  1), t, sproj2_sigma_31   )  ! <- 13
  call clovervv(w(1, 1, 1, EVEN, 2), t, sproj2_sigma_14_ch)
  call clovervv(w(1, 1, 1, ODD,  2), t, sproj2_sigma_23   )
  call clovervv(w(1, 1, 1, EVEN, 3), t, sproj2_sigma_42_ch)  ! <- 24
  call clovervv(w(1, 1, 1, ODD,  3), t, sproj2_sigma_34_ch)
#elif defined GAMMA_NOTATION_DDHMC
  call clovervv(w(1, 1, 1, EVEN, 1), t, sproj2_sigma_12   )
  call clovervv(w(1, 1, 1, ODD,  1), t, sproj2_sigma_31   )  ! <- 13
  call clovervv(w(1, 1, 1, EVEN, 2), t, sproj2_sigma_41_ch)
  call clovervv(w(1, 1, 1, ODD,  2), t, sproj2_sigma_23   )
  call clovervv(w(1, 1, 1, EVEN, 3), t, sproj2_sigma_24_ch)  ! <- 24
  call clovervv(w(1, 1, 1, ODD,  3), t, sproj2_sigma_43_ch)
#else
  call clovervv(w(1, 1, 1, EVEN, 1), t, sproj2_sigma_12   )
  call clovervv(w(1, 1, 1, ODD,  1), t, sproj2_sigma_31   )  ! <- 13
  call clovervv(w(1, 1, 1, EVEN, 2), t, sproj2_sigma_41_nr)
  call clovervv(w(1, 1, 1, ODD,  2), t, sproj2_sigma_23   )
  call clovervv(w(1, 1, 1, EVEN, 3), t, sproj2_sigma_24_nr)  ! <- 42
  call clovervv(w(1, 1, 1, ODD,  3), t, sproj2_sigma_43_nr)
#endif

 !$omp parallel do private(col1, col2, i, eo, mu)
 do mu = 1, 3
 do eo = EVEN, ODD
 do i = 1, volh
    do col2 = 1, 3
       do col1 = 1, 3
          w_add(col1, col2, i, eo, mu) = w_add(col1, col2, i, eo, mu) &
                                       + s * w(col1, col2, i, eo, mu)
       enddo
    enddo
  enddo
  enddo
  enddo

  deallocate(w)

  DEBUG2S("End: clover_dsd_w")
  TIMING_STOP(timing_bin_clover_dsd_w)
end

!-------------------------------------------------------------------------------
subroutine clovervv(w, t, sproj_sum)
  use module_vol
  implicit none
  COMPLEX, dimension(3, 3, volh_tot) :: w
  COMPLEX, dimension(4, 4, 3, 3, volh) :: t
  COMPLEX :: aa(4)
  external :: sproj_sum
  integer :: i, c1, c2

#ifdef PATHSCALE
  !$omp parallel do private(c1, c2, aa) shared(sproj_sum)
#else
  !$omp parallel do private(c1, c2, aa)
#endif
  do i = 1, volh
     do c2 = 1, 3
        do c1 = 1, 3
           call sproj_sum(aa, t(1, 1,c1, c2, i))
           w(c1, c2, i) = aa(1)+aa(2)+aa(3)+aa(4)
        enddo
     enddo
  enddo
end

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