!===============================================================================
!
! 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 dsfm(p, p_qed, p_axion, step, calc_sf, pf)
  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
  U1_GENERATOR_FIELD, intent(inout) :: p_qed
  AXION_MOMENTUM_FIELD, intent(inout) :: p_axion
  integer,         intent(in)    :: calc_sf
  REAL,            intent(in)    :: step
  type(type_pfermi)              :: pf
  P_SPINCOL_FIELD, save          :: a, b
  REAL, external                 :: dotprod

  if (switches%quenched) return
  TIMING_START(timing_bin_dsf_mtmp)

  call init_quark(pf%mid1)
  call init_quark(pf%mid2)
  ALLOCATE_SC_FIELD(a)
  ALLOCATE_SC_FIELD(b)

  if (pf%mid2 /=0 )  then
  TIMING_START(timing_bin_wdag_r8)
     call wdag_r8(b, pf%mpf(1)%sc, pf%mid2)
  TIMING_STOP(timing_bin_wdag_r8)

  TIMING_START(timing_bin_cg_mre_mtmp)
#ifdef QPACE
     call solve_invmtdagmt(a, b, pf%mid1, pf%pid, calc_sf)
#else
     call cg_mre_mtmp(a, b, pf%mid1, pf%pid, calc_sf)
#endif
  TIMING_STOP(timing_bin_cg_mre_mtmp)

  else
  TIMING_START(timing_bin_cg_mre_mtmp)
#ifdef QPACE
     call solve_invmtdagmt(a, pf%mpf(1)%sc, pf%mid1, pf%pid, calc_sf)
#else
     call cg_mre_mtmp(a, pf%mpf(1)%sc, pf%mid1, pf%pid, calc_sf)
#endif
  TIMING_STOP(timing_bin_cg_mre_mtmp)
  endif

  TIMING_START(timing_bin_wmul_r8)
  call wmul_r8(b, a, pf%mid1)
  TIMING_STOP(timing_bin_wmul_r8)

  if (calc_sf /= 0) pf%sf = dotprod(b, b, SIZE_SC_FIELD)
  if (step == ZERO) return

  TIMING_START(timing_bin_dsf)
  call hmc_forces_old(p)
  if (pf%mid2 ==0 ) then
     call dsf(p, p_qed, p_axion, step, a, b, pf%mid1)
  else
     if (switches%mass_kappa) then
        call dsf(p, p_qed, p_axion,  step, a, b           ,pf%mid1)
        call dsf(p, p_qed, p_axion, -step, a, pf%mpf(1)%sc,pf%mid2)
     else
        call sc_axpy(b, pf%mpf(1)%sc, -ONE)
        call dsf(p, p_qed, p_axion, step, a, b, pf%mid1)
     endif
  endif
  call hmc_forces_new(p, step, pf%fid)
  TIMING_STOP(timing_bin_dsf)
  TIMING_STOP(timing_bin_dsf_mtmp)
end

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