!===============================================================================
!
! clover_bsa.F90 - calculates "B sigma A"
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 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_bsa_w(w_add, s, b, a)
  use module_vol
  implicit none

  GAUGE_FIELD,     intent(inout) :: w_add
  SPINCOL_FIELD,   intent(in)    :: a, b
  REAL   ,         intent(in)    :: s
!!  GAUGE_FIELD :: w
  integer :: i, eo, mu

  COMPLEX, allocatable :: w(:, :, :, :, :)
  integer :: ierr

  external :: sproj_sigma_12 , sproj_sigma_21
  external :: sproj_sigma_13
  external :: sproj_sigma_23 , sproj_sigma_32
  external :: sproj_sigma_41_nr , sproj_sigma_41_ch, sproj_sigma_14_ch
  external :: sproj_sigma_42_nr , sproj_sigma_24_ch, sproj_sigma_42_ch
  external :: sproj_sigma_43_nr , sproj_sigma_43_ch, sproj_sigma_34_ch

  if (s == ZERO) return

  TIMING_START(timing_bin_clover_bsa_w)
  DEBUG2S("Start: clover_bsa_w")

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

#ifdef GAMMA_NOTATION_CHROMA
  call clover_bsa(w(1, 1, 1, EVEN, 1), b, a, sproj_sigma_21   )
  call clover_bsa(w(1, 1, 1, ODD , 1), b, a, sproj_sigma_13   )
  call clover_bsa(w(1, 1, 1, EVEN, 2), b, a, sproj_sigma_41_ch)
  call clover_bsa(w(1, 1, 1, ODD , 2), b, a, sproj_sigma_32   )
  call clover_bsa(w(1, 1, 1, EVEN, 3), b, a, sproj_sigma_24_ch)
  call clover_bsa(w(1, 1, 1, ODD , 3), b, a, sproj_sigma_43_ch)
#elif defined GAMMA_NOTATION_CHIRAL
  call clover_bsa(w(1, 1, 1, EVEN, 1), b, a, sproj_sigma_12   )
  call clover_bsa(w(1, 1, 1, ODD , 1), b, a, sproj_sigma_13   )
  call clover_bsa(w(1, 1, 1, EVEN, 2), b, a, sproj_sigma_14_ch)
  call clover_bsa(w(1, 1, 1, ODD , 2), b, a, sproj_sigma_23   )
  call clover_bsa(w(1, 1, 1, EVEN, 3), b, a, sproj_sigma_24_ch)
  call clover_bsa(w(1, 1, 1, ODD , 3), b, a, sproj_sigma_34_ch)
#elif defined GAMMA_NOTATION_DDHMC
  call clover_bsa(w(1, 1, 1, EVEN, 1), b, a, sproj_sigma_12   )
  call clover_bsa(w(1, 1, 1, ODD , 1), b, a, sproj_sigma_13   )
  call clover_bsa(w(1, 1, 1, EVEN, 2), b, a, sproj_sigma_41_ch)
  call clover_bsa(w(1, 1, 1, ODD , 2), b, a, sproj_sigma_23   )
  call clover_bsa(w(1, 1, 1, EVEN, 3), b, a, sproj_sigma_42_ch)
  call clover_bsa(w(1, 1, 1, ODD , 3), b, a, sproj_sigma_43_ch)
#else
  call clover_bsa(w(1, 1, 1, EVEN, 1), b, a, sproj_sigma_12   )
  call clover_bsa(w(1, 1, 1, ODD , 1), b, a, sproj_sigma_13   )
  call clover_bsa(w(1, 1, 1, EVEN, 2), b, a, sproj_sigma_41_nr)
  call clover_bsa(w(1, 1, 1, ODD , 2), b, a, sproj_sigma_23   )
  call clover_bsa(w(1, 1, 1, EVEN, 3), b, a, sproj_sigma_42_nr)
  call clover_bsa(w(1, 1, 1, ODD , 3), b, a, sproj_sigma_43_nr)
#endif

  w_add(1:NCOL, 1:NCOL, 1:volh, 0:1, 1:3) = &
  w_add(1:NCOL, 1:NCOL, 1:volh, 0:1, 1:3) + &
  s * w(1:NCOL, 1:NCOL, 1:volh, 0:1, 1:3)

!  do mu = 1, 3
!     do eo = EVEN, ODD
!        !$omp parallel do
!        do i = 1, volh
!           call u_scale(w(1, 1, i, eo, mu), s)
!           call u_add(w_add(1, 1, i, eo, mu), w(1, 1, i, eo, mu))
!        enddo
!     enddo
!  enddo

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

  DEBUG2S("End: clover_bsa_w")
  TIMING_STOP(timing_bin_clover_bsa_w)

end

!-------------------------------------------------------------------------------
subroutine clover_bsa(w,b,a,sproj) ! w = transposed(conjg(b) sigma_mu_nu a)
  use module_vol
  use module_p_interface
  implicit none

  SU3_FIELD, intent(out)    :: w
  SPINCOL_FIELD, intent(in) :: b, a
  P_SPINCOL_FIELD, save     :: aa
  integer                   :: i, ca, cb
  external                  :: sproj

  ALLOCATE_SC_FIELD(aa)

#ifdef PATHSCALE
  !$omp parallel do private(ca) shared(sproj)
#else
  !$omp parallel do private(ca)
#endif
  do i = 1, volh
     do ca = 1, NCOL
        call sproj(aa(1, ca, i), a(1, ca, i))
     enddo
  enddo

  !$omp parallel do
  do i = 1, volh
     call transposed_su3_conjg_spin_spin(w(1,1,i), aa(1,1,i), b(1,1,i))
  enddo

end

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