!===============================================================================
!
! dsf_hhdd.F90
!
!-------------------------------------------------------------------------------
!
! 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_hhdd(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_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
  integer :: ip

  sf = ZERO
  if (switches%quenched) return
  DEBUG2S("Start: dsf_hh")

  call init_quark(action%fermi(1)%mid1)


  call cg_unprec_mdagm_dd_outer(a, mpf(id)%ddsc, action%fermi(id)%mid1,          id, calc_sf)
  call unprec_mmul_dd(          b, a,            action%fermi(id)%mid1)
  if (calc_sf /= 0) sf = dotprod(b, b, 2* SIZE_SC_FIELD)

  if (step /= ZERO) then
     call hmc_forces_old(p)
     call dsf_mtdagmt_hhdd(p, step, a, b, action%fermi(id)%mid1)
     call hmc_forces_new(p, step, i_sf1)
  endif
  DEBUG2S("End: dsf_hh")

end

!-------------------------------------------------------------------------------
subroutine dsf_mtdagmt_hhdd(p, step, a, b, mid, np)
  use module_vol
  use module_dd
  implicit none

  GENERATOR_FIELD, intent(inout) :: p
  REAL,            intent(in)    :: step
  COMPLEX, dimension (4,3,ld%lat%volh, 0:ld%lat%num_ip-1,0:1),intent(in) :: a,b
  integer,         intent(in)    :: mid, np

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

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

  w  = ZERO
  w1 = ZERO
  w2 = ZERO
  call dsf_sum_hhdd(w, w1, w2,  step, a, b, mid, np)
  call dsf_w2gen(p, w, w1, w2, mid)

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

!-------------------------------------------------------------------------------
subroutine dsf_sum_hhdd(w, w1, w2, step, a, b, id, np)
  use module_vol
  use module_dd
  implicit none

  GAUGE_FIELD,     intent(inout) :: w, w1, w2
  REAL,            intent(in)    :: step
  COMPLEX, dimension (4,3,ld%lat%volh, 0:ld%lat%num_ip-1,0:1):: a,b,bt,tmp
  integer,intent(in) :: id, np

!!  TIMING2_START(timing2_bin_dsf_sum)
  DEBUG2S("Start: dsf_sum_hh")

  call dsf_unprec_dd(w, w1, w2,  step, a, b, id, 0)

  DEBUG2S("End: dsf_sum_hh")
!!  TIMING2_STOP(timing2_bin_dsf_sum)
end

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