!===============================================================================
!
! dsf_dd.F90  --  DD version
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2009-2010 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_dd(p, step, calc_sf, sf, id)
  use module_action
  use module_field
  use module_hmc_forces
  use module_switches
  use module_vol
  use module_dd
  implicit none

  GENERATOR_FIELD, intent(inout) :: p
  integer,         intent(in)    :: calc_sf, id
  REAL,            intent(in)    :: step
  REAL,            intent(out)   :: sf

  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1) :: a, b
  REAL, external                 :: dotprod
  integer :: mid1, mid2

  sf = ZERO
  if (switches%quenched) return
  DEBUG2S("Start: dsf_dd")
  mid1=action%fermi(id)%mid1
  mid2=action%fermi(id)%mid2

  call init_quark(mid1)

  if (mid2 /=0 )  then
     call init_quark(mid2)
     call wtdag_all_dd(b,mpf(id)%sc(1,1,1), mid2)
     call cg_mre_wtdagwt_dd(a,b,mid1,id,calc_sf)
  else
     call cg_mre_wtdagwt_dd(a,mpf(id)%sc(1,1,1),mid1,id,calc_sf)
  endif
  call wtmul_all_dd(b,a,mid1)

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

  call hmc_forces_old(p)
  if (mid2 ==0 ) then
     call dsf_mtdagmt_dd(p, step, a, b, mid1)
  else
     if (switches%mass_kappa) then
        call dsf_mtdagmt_dd(p, step, a, b,                 mid1)
        call dsf_mtdagmt_dd(p,-step, a, mpf(id)%sc(1,1,1), mid2)
     else
        call sc_axpy(b, mpf(id)%sc(1,1,1), -ONE)
        call dsf_mtdagmt_dd(p, step, a, b,                 mid1)
     endif
  endif
  call hmc_forces_new(p, step, action%fermi(id)%fid)  

  DEBUG2S("End: dsf_dd")

end
!-------------------------------------------------------------------------------
subroutine dsf_hh(p, step, calc_sf, sf, id)
  use module_action
  use module_field
  use module_hmc_forces
  use module_p_interface
  use module_switches
  use module_switches
  use module_vol
  use module_dd
  use module_function_decl
  implicit none

  GENERATOR_FIELD, intent(inout) :: p
  integer,         intent(in)    :: calc_sf, id
  REAL,            intent(in)    :: step
  REAL,            intent(out)   :: sf

!!  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: a, b
!!  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: tmp
  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1):: a, b
  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1):: tmp
  integer :: mid1, mid2, ip

  sf = ZERO
  if (switches%quenched) return
  DEBUG2S("Start: dsf_hh")
  mid1=action%fermi(id)%mid1
  mid2=action%fermi(id)%mid2

  call init_quark(mid1)
  if (mid2 /=0 )  then
     call init_quark(mid2)
     call unprec_hdag(b,mpf(id)%sc,mid2)
     call cg_mre_unprec_hdagh(a,          b,mid1,id,calc_sf)
  else
     call cg_mre_unprec_hdagh(a, mpf(id)%sc,mid1,id,calc_sf)
!!       call invhdag(b, mpf(id)%sc,mid1,calc_sf)
  endif
!!  call invh(   a, b, mid1,calc_sf)
  call    unprec_hmul(b,a,         mid1)

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

  call hmc_forces_old(p)
  if (mid2 ==0 ) then
     call dsf_mtdagmt_hh(p, step, a, b, mid1)
  else
     if (switches%mass_kappa) then
        call dsf_mtdagmt_hh(p, step, a, b,          mid1)
        call dsf_mtdagmt_hh(p,-step, a, mpf(id)%sc, mid2)
     else
!!        b=b-mpf(id)%ddsc
        call dsf_mtdagmt_hh(p, step, a, b,          mid1)
        call dsf_mtdagmt_hh(p,-step, a, mpf(id)%sc, mid1)
     endif
  endif
  call hmc_forces_new(p, step, action%fermi(id)%fid)  
  DEBUG2S("End: dsf_hh")
end

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
subroutine dsf_hh2(p, step, calc_sf, sf, id)
  use module_action
  use module_field
  use module_hmc_forces
  use module_p_interface
  use module_switches
  use module_switches
  use module_vol
  use module_dd
  use module_function_decl
  implicit none

  GENERATOR_FIELD, intent(inout) :: p
  integer,         intent(in)    :: calc_sf, id
  REAL,            intent(in)    :: step
  REAL,            intent(out)   :: sf

!!  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: a, b
!!  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1,0:1):: tmp
  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1):: a, b
  COMPLEX, dimension(NDIRAC,NCOL,ld%lat%volh,0:ld%lat%num_ip-1):: tmp
  integer :: mid1, mid2, ip

  sf = ZERO
  if (switches%quenched) return
  DEBUG2S("Start: dsf_hh")
  mid1=action%fermi(id)%mid1
  mid2=action%fermi(id)%mid2

  call init_quark(mid1)
  if (mid2 /=0 )  then
     call init_quark(mid2)
     call unprec_hdag(b,mpf(id)%sc,mid2)
     call cg_mre_unprec_hdagh(a,          b,mid1,id,calc_sf)
  else
     call cg_mre_unprec_hdagh(a, mpf(id)%sc,mid1,id,calc_sf)
  endif
  call    unprec_hmul(b,a,         mid1)

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

  call hmc_forces_old(p)
  if (mid2 ==0 ) then
     call dsf_mtdagmt_hh(p, step, a, b, mid1)
  else
     if (switches%mass_kappa) then
        call dsf_mtdagmt_hh(p, step, a, b,          mid1)
        call dsf_mtdagmt_hh(p,-step, a, mpf(id)%sc, mid2)
     else
!!        b=b-mpf(id)%ddsc
        call dsf_mtdagmt_hh(p, step, a, b,          mid1)
        call dsf_mtdagmt_hh(p,-step, a, mpf(id)%sc, mid1)
     endif
  endif
  call hmc_forces_new(p, step, action%fermi(id)%fid)  
  DEBUG2S("End: dsf_hh")
end

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