!===============================================================================
!
! w_mult.F90  -  W := M~ + rho (Hasenbusch improvement)
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2006-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 wdagw(out, in, id)  ! out = (W+ W) in
  use module_vol
  use module_p_interface
  implicit none
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  P_SPINCOL_FIELD, save :: tmp
  integer,intent(in) :: id

  TIMING_START(timing_bin_mtdagmt)
  ALLOCATE_SC_FIELD(tmp)
  call wmul(tmp(1,1,1), in,  id)
  call wdag(out, tmp(1,1,1), id)
  TIMING_STOP(timing_bin_mtdagmt)
end

!-------------------------------------------------------------------------------
subroutine wmul(out, in, id)  ! out = W in
  use module_vol
  use module_action
  implicit none
  integer,intent(in) :: id
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  REAL :: rho

  call mtil(out, in, id)
  if(action%mtilde(id)%rho /= ZERO) then
     rho = action%mtilde(id)%rho
     call sc_axpy(out, in, rho)
  endif
end

!-------------------------------------------------------------------------------
subroutine wdag(out, in, id)  ! out = W in
  use module_vol
  use module_action
  implicit none
  integer,intent(in) :: id
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  REAL :: rho

  call mtil_dag(out, in, id)
  if(action%mtilde(id)%rho /= ZERO) then
     rho = action%mtilde(id)%rho
     call sc_axpy(out, in, rho)
  endif
end

!-------------------------------------------------------------------------------
subroutine clover_mult(out, in, cid, eo)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  integer, intent(in) :: cid, eo

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_a(out, clover(cid)%cfield%a(1,1,eo), in, volh)
  else
     call clover_mult_a12(out, clover(cid)%cfield12%a(1,eo), in, volh)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_mult_block(out, in, b, cid, eo, i1, i2)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  integer, intent(in) :: cid, eo, i1, i2
  REAL, intent(in) :: b

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_a2_block(out, b, clover(cid)%cfield%a(1,1,eo), in, i1, i2)
  else
     call clover_mult_a12_block(out, b, clover(cid)%cfield12%a(1,eo), in, i1, i2)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_inv_mult(inout, cid, eo)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(inout) :: inout
  integer, intent(in) :: cid, eo

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_ao(clover(cid)%cfield%i(1,1,eo), inout, volh)
  else
     call clover_mult_ao12(clover(cid)%cfield12%i(1,eo), inout, volh)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_inv_mult_block(inout, cid, eo, i1, i2)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(inout) :: inout
  integer, intent(in) :: cid, eo, i1, i2

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_ao_block(clover(cid)%cfield%i(1,1,eo), inout, i1, i2)
  else
     call clover_mult_ao12_block(clover(cid)%cfield12%i(1,eo), inout, i1, i2)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_inv2_mult_block(out, in, cid, eo, i1, i2)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  integer, intent(in) :: cid, eo, i1, i2

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_ao2_block(out, clover(cid)%cfield%i(1,1,eo), in, i1, i2)
  else
     call clover_mult_ao122_block(out, clover(cid)%cfield12%i(1,eo), in, i1, i2)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_dag_mult(out, in, cid, eo)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  integer, intent(in) :: cid, eo

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_a(out, clover(cid)%cfield%a(1,1,eo), in, volh)
  else
     call clover_mult_a12dag(out, clover(cid)%cfield12%a(1,eo), in, volh)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_dag_mult_block(out, in, b, cid, eo, i1, i2)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  integer, intent(in) :: cid, eo, i1, i2
  REAL, intent(in) :: b

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_a2_block(out, b, clover(cid)%cfield%a(1,1,eo), in, i1, i2)
  else
     call clover_mult_a12dag_block(out, b, clover(cid)%cfield12%a(1,eo), in, i1, i2)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_dag_inv_mult(inout, cid, eo)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(inout) :: inout
  integer, intent(in) :: cid, eo

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_ao(clover(cid)%cfield%i(1,1,eo), inout, volh)
  else
     call clover_mult_ao12dag(clover(cid)%cfield12%i(1,eo), inout, volh)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_dag_inv_mult_block(inout, cid, eo, i1, i2)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(inout) :: inout
  integer, intent(in) :: cid, eo, i1, i2

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_ao_block(clover(cid)%cfield%i(1,1,eo), inout, i1, i2)
  else
     call clover_mult_ao12dag_block(clover(cid)%cfield12%i(1,eo), inout, i1, i2)
  endif

end

!-------------------------------------------------------------------------------
subroutine clover_dag_inv2_mult_block(out, in, cid, eo, i1, i2)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  integer, intent(in) :: cid, eo, i1, i2

  if (clvpar(cid)%lambdakappa == ZERO .and. finv_axion == ZERO) then
     call clover_mult_ao2_block(out, clover(cid)%cfield%i(1,1,eo), in, i1, i2)
  else
     call clover_mult_ao122dag_block(out, clover(cid)%cfield12%i(1,eo), in, i1, i2)
  endif

end

!-------------------------------------------------------------------------------
subroutine unprec_wmul(oe, oo, ie, io, id)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: oe, oo
  SPINCOL_FIELD, intent(in)  :: ie, io
  SPINCOL_FIELD :: tmp
  integer,intent(in) :: id
  COMPLEX :: fac1, fac2
  COMPLEX, parameter :: zone = cmplx(1,0)

  if (chemi /= 0 .or. chemi_i/=0) then
     fac1=exp(cmplx( chemi, chemi_i))
     fac2=exp(cmplx(-chemi,-chemi_i))
     call emuu4(gauge(2)%u, fac1, fac2, .false.)
  endif

  call d(se, so, oe, io, gauge(2)%u(1,1,1,0,1))
  if (action%mtilde(id)%cid /=0)then
     call clover_mult(tmp, ie, action%mtilde(id)%cid, se)
     call sc_xpby(oe, tmp, - action%mtilde(id)%kappa)
  else
     call sc_xpby(oe, ie, - action%mtilde(id)%kappa)
  endif


  call d(so, se, oo, ie, gauge(2)%u(1,1,1,0,1))
  if (action%mtilde(id)%cid /=0)then
     call clover_mult(tmp, io, action%mtilde(id)%cid, so)
     call sc_xpby(oo, tmp, - action%mtilde(id)%kappa)
  else
     call sc_xpby(oo, io, - action%mtilde(id)%kappa)
  endif

  if (chemi /= 0 .or. chemi_i/=0)call emuu4(gauge(2)%u, zone, zone, .false.)

end

!-------------------------------------------------------------------------------
subroutine unprec_wdag(oe, oo, ie, io, id)
  use module_vol
  use module_field
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: oe, oo
  SPINCOL_FIELD, intent(in)  :: ie, io
  SPINCOL_FIELD :: tmp
  integer,intent(in) :: id
  COMPLEX :: fac1, fac2
  COMPLEX, parameter :: zone = cmplx(1,0)

  if (chemi /= 0 .or. chemi_i/=0) then
     fac1=exp(cmplx(-chemi, chemi_i))
     fac2=exp(cmplx( chemi,-chemi_i))
     call emuu4(gauge(2)%u, fac1, fac2, .false.)
  endif

  call d_dag(se, so, oe, io, gauge(2)%u(1,1,1,0,1))
  if (action%mtilde(id)%cid /=0)then
     call clover_mult(tmp, ie, action%mtilde(id)%cid, se)
     call sc_xpby(oe, tmp, - action%mtilde(id)%kappa)
  else
     call sc_xpby(oe, ie, - action%mtilde(id)%kappa)
  endif


  call d_dag(so, se, oo, ie, gauge(2)%u(1,1,1,0,1))
  if (action%mtilde(id)%cid /=0)then
     call clover_mult(tmp, io, action%mtilde(id)%cid, so)
     call sc_xpby(oo, tmp, - action%mtilde(id)%kappa)
  else
     call sc_xpby(oo, io, - action%mtilde(id)%kappa)
  endif

  if (chemi /= 0 .or. chemi_i/=0)call emuu4(gauge(2)%u, zone, zone, .false.)

end

!-------------------------------------------------------------------------------
subroutine unprec_cmul(oe, oo, ie, io, id)
  use module_vol
  use module_action
  implicit none
  SPINCOL_FIELD, intent(out) :: oe, oo
  SPINCOL_FIELD, intent(in)  :: ie, io
  integer,intent(in) :: id

  if (action%mtilde(id)%cid /=0)then
     call clover_mult(oe, ie, action%mtilde(id)%cid, se)
     call clover_mult(oo, io, action%mtilde(id)%cid, so)
  else
     call sc_copy(oe, ie)
     call sc_copy(oo, io)
  endif
end

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