!===============================================================================
!
! dsf_mtmp.F90  --  p(j,x,mu) := p(j,x,mu) - step * D_{x,mu,j} S_{f}
!
! modified for all mass preconditioning terms, 28.04.2009, yn
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2009 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 dsf_unprec_wilson(p, step, calc_sf, sf, fid)
  use module_action
  use module_field
  use module_hmc_forces
  use module_p_interface
  use module_switches
  use module_vol
  implicit none

  GENERATOR_FIELD, intent(inout) :: p
  integer,         intent(in)    :: fid, calc_sf
  REAL,            intent(in)    :: step
  REAL,            intent(out)   :: sf
  P_SPINCOL_FIELD, save          :: ae, be
  P_SPINCOL_FIELD, save          :: ao, bo
  P_SPINCOL_FIELD, save          :: ate, ato
  REAL, external                 :: dotprod
  integer :: mid1, ierr
  P_GAUGE_FIELD, save :: w, we, wo
  REAL :: s, s1

  sf = ZERO
  if (switches%quenched) return
  TIMING_START(timing_bin_dsf_unprec_wilson)


  DEBUG2S("Start: dsf_unprec_wilson")

  mid1 = action%fermi(fid)%mid1
  call init_quark(mid1)

  ALLOCATE_SC_FIELD(ae)
  ALLOCATE_SC_FIELD(be)
  ALLOCATE_SC_FIELD(ao)
  ALLOCATE_SC_FIELD(bo)
  ALLOCATE_SC_FIELD(ate)
  ALLOCATE_SC_FIELD(ato)
  ALLOCATE_G_FIELD(w)
  ALLOCATE_G_FIELD(we)
  ALLOCATE_G_FIELD(wo)

  TIMING_START(timing_bin_solve_invmdagm_byqnohat)
  call solve_invmdagm_byqnohat(ae, ao, mpf(fid)%sc_e, mpf(fid)%sc_o, mid1,fid,calc_sf)
  TIMING_START(timing_bin_solve_invmdagm_byqnohat)

  TIMING_START(timing_bin_unprec_mmul)
  call unprec_mmul(be, bo, ae, ao, mid1)
  TIMING_STOP(timing_bin_unprec_mmul)
  if (calc_sf /= 0) sf = dotprod(be, be, SIZE_SC_FIELD) + dotprod(bo, bo, SIZE_SC_FIELD)
  if (step == ZERO) return


  TIMING_START(timing_bin_unprec_dsf)
  call hmc_forces_old(p)
  we=0
  wo=0
  w=0

  s  = -step * TWO * action%mtilde(mid1)%kappa
  s1 = -step * TWO * (action%mtilde(mid1)%cswkappa / EIGHT) * action%mtilde(mid1)%kappa
  if (s1 /= ZERO) then
     call clover_mult_b(clover(action%mtilde(mid1)%cid)%b(1,1,EVEN), be, volh)
     call clover_mult_b(clover(action%mtilde(mid1)%cid)%b(1,1,ODD ), bo, volh)
  endif
  call xbound_sc_field(ae)
  call xbound_sc_field(be)
  call xbound_sc_field(ao)
  call xbound_sc_field(bo)
  call dsf_xyztfb_w(w, gauge(2)%u(1,1,1,0,1), s, ae, be, ao, bo, EVEN)
  if (s1 /= ZERO) then
     call d(ODD, EVEN, ato, ae, gauge(2)%u(1,1,1,0,1))
     call d(EVEN, ODD, ate, ao, gauge(2)%u(1,1,1,0,1))
     call clover_mult_b(clover(action%mtilde(mid1)%cid)%b(1,1,EVEN), ate, volh)
     call clover_mult_b(clover(action%mtilde(mid1)%cid)%b(1,1,ODD ), ato, volh)
     call xbound_sc_field(ate)
     call xbound_sc_field(ato)
     call clover_bsa_w(we, s1, be, ate)
     call clover_bsa_w(wo, s1, bo, ato)
  endif

  if (se == EVEN) then
     call dsf_w2gen(p, w, we, wo, mid1)
  else
     call dsf_w2gen(p, w, wo, we, mid1)
  endif
  call hmc_forces_new(p, step, action%fermi(fid)%fid)
  TIMING_STOP(timing_bin_unprec_dsf)

  call sc_zero_halo(ae)
  call sc_zero_halo(be)
  call sc_zero_halo(ao)
  call sc_zero_halo(ate)
  call sc_zero_halo(ato)
  DEBUG2S("End: dsf_unprec_wilson")
  TIMING_STOP(timing_bin_dsf_unprec_wilson)
end

!-------------------------------------------------------------------------------
subroutine solve_invmdagm_byqnohat(xe, xo, be, bo, mid, fid, calc_sf)
  use module_field
  use module_action
  use module_switches
  use module_vol
  use module_p_interface
  implicit none

  SPINCOL_FIELD, intent(out) :: xe, xo
  SPINCOL_FIELD, intent(in)  :: be, bo
  P_SPINCOL_FIELD, save      :: tmpe, tmpo, tmp1e, tmp1o
  integer :: mid, fid, calc_sf

  TIMING_START(timing_bin_solve_invmdagm_byqnohat)
#ifdef QPACE
  xo=0
  xe=0
  ALLOCATE_SC_FIELD(tmpe)
  ALLOCATE_SC_FIELD(tmpo)
  ALLOCATE_SC_FIELD(tmp1e)
  ALLOCATE_SC_FIELD(tmp1o)
  tmpe=be
  tmpo=bo

  call gamma5(tmpe, volh)
  call gamma5(tmpo, volh)
  call dds(tmpe, tmpo, tmp1e, tmp1o, gauge(2)%u, mid)

  call gamma5(tmp1e, volh)
  call gamma5(tmp1o, volh)

  if ( switches%clover ) then
  call clover_mult_a(tmpe, clover(action%mtilde(mid)%cid)%a(1,1,EVEN), tmp1e, volh)
  call clover_mult_a(tmpo, clover(action%mtilde(mid)%cid)%a(1,1,ODD ), tmp1o, volh)

  call clover_mult_a(tmp1e, clover(action%mtilde(mid)%cid)%a(1,1,EVEN), tmpe, volh)
  call clover_mult_a(tmp1o, clover(action%mtilde(mid)%cid)%a(1,1,ODD ), tmpo, volh)
  endif
  call dds(tmp1e, tmp1o, xe, xo, gauge(2)%u, mid)


#else
  xe=be
  xo=bo
  call cg_unprec_outer(xe, xo, be, bo, mid, fid, calc_sf)
#endif

  TIMING_STOP(timing_bin_solve_invmdagm_byqnohat)
end

!-------------------------------------------------------------------------------
subroutine solve_invmtdagmt(xe, be, mid, fid, calc_sf)
  use module_field
  use module_action
  use module_switches
  use module_vol
  use module_p_interface
  implicit none

  SPINCOL_FIELD, intent(out) :: xe
  SPINCOL_FIELD, intent(in)  :: be
  integer                    :: mid, fid, calc_sf

  P_SPINCOL_FIELD, save      :: tmpe, tmpo, tmp1e, tmp1o

  ALLOCATE_SC_FIELD(tmpe)
  ALLOCATE_SC_FIELD(tmpo)
  ALLOCATE_SC_FIELD(tmp1e)
  ALLOCATE_SC_FIELD(tmp1o)

  tmpe=be
  call gamma5(tmpe, volh)
  tmpo=0
#ifdef QPACE
  call dds(tmpe, tmpo, tmp1e, tmp1o, gauge(2)%u, mid, 1)
#else
  call solve(tmp1e, tmp1o, tmpe, tmpo, mid)
#endif

  call gamma5(tmp1e, volh)
  if (action%mtilde(mid)%cid /=0) then
     call clover_mult_a(tmpe,clover(action%mtilde(mid)%cid)%a(1,1,EVEN),tmp1e,volh)
     call clover_mult_a(tmp1e,clover(action%mtilde(mid)%cid)%a(1,1,EVEN),tmpe,volh)
  endif

  tmp1o=0
#ifdef QPACE
  call dds(tmp1e, tmp1o, xe, tmpo, gauge(2)%u, mid, 0)
#else
  call solve(xe, tmpo, tmp1e, tmp1o, mid)
#endif
end
!===============================================================================
