!===============================================================================
!
! hmc_integrator_p.F90 - integrators for the different models
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007-2013 Yoshifumi Nakamura 
!                    2013 Hinnerk Stueben
!
! 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/>.
!
!-------------------------------------------------------------------------------
! Modified for PFHMC, PF-RHMC and tRHMC
!
! Editor: Taylor Haar
! Last modified: 16/03/2017
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
subroutine hmc_integrator_p(p, p_qed, p_axion, para, conf, i, calc_sf)
  use module_integrator, only: n_time_scale, step_q
  use typedef_hmc
  use module_vol
  implicit none

  GENERATOR_FIELD,    intent(inout) :: p
  U1_GENERATOR_FIELD, intent(inout) :: p_qed
  AXION_MOMENTUM_FIELD, intent(inout) :: p_axion
  type(hmc_para),     intent(in)    :: para
  type(hmc_conf),     intent(in)    :: conf
  integer,            intent(in)    :: calc_sf, i
  integer :: j

  do j = 1, n_time_scale
     call hmc_inte_p_control(p, p_qed, p_axion, para, conf, step_q(i,j), calc_sf, j)
  enddo

end subroutine hmc_integrator_p

!-------------------------------------------------------------------------------
subroutine hmc_inte_p_control(p, p_qed, p_axion, para, conf, step, calc_sf, i)
  use module_field, only: gauge
  use module_action, only: action, n_pfermi
  use module_input
  use typedef_hmc
  use module_vol
  use module_switches
  implicit none

  GENERATOR_FIELD,    intent(inout) :: p
  U1_GENERATOR_FIELD, intent(inout) :: p_qed
  AXION_MOMENTUM_FIELD, intent(inout) :: p_axion
  type(hmc_para),     intent(in)    :: para
  type(hmc_conf),     intent(in)    :: conf
  REAL,               intent(in)    :: step
  integer,            intent(in)    :: calc_sf, i
  integer :: p_done, ipf
  character(len = 80) :: msg

  if (step == ZERO .and. calc_sf == 0) return

  DEBUG2S("Start: hmc_inte_p_control")
  TIMING_START(timing_bin_hmc_steps)

  p_done = 0

  if (switches%dynamical) then
  do ipf = 1, n_pfermi
     if (action%pfermi(ipf)%mts /= i ) cycle
     if (action%pfermi(ipf)%nth == 1 ) then
        ! Standard 2-flavour HMC
        if (action%pfermi(ipf)%polyid > 0) then
           ! Polynomial
           call dsf_poly(p, p_qed, p_axion, step, calc_sf, action%pfermi(ipf))
           p_done=p_done+1
        else
           ! Hasenbusch or plain HMC
           call dsfm(p, p_qed, p_axion, step, calc_sf, action%pfermi(ipf))
           p_done=p_done+1
        endif
     else
        ! RHMC
        if (action%pfermi(ipf)%polyid > 0) then
           if (action%pfermi(ipf)%rid > 0) then
              ! Rational (correction) term = pdag R(K)P^-1(K) p
              call dsfr_z(p, p_qed, p_axion, step, calc_sf, action%pfermi(ipf))
              p_done=p_done+1
           else
              ! Polynomial filter = pdag P(K) p
              call dsf_poly(p, p_qed, p_axion, step, calc_sf, action%pfermi(ipf))
              p_done=p_done+1
           endif
        else
           ! Plain RHMC or tRHMC
           if (switches%zolotarev) then
              ! With Zolotarev approx
              call dsfr_z(p, p_qed, p_axion, step, calc_sf, action%pfermi(ipf))
              p_done=p_done+1
           else
              ! With Remez approx
              call dsfr(p, p_qed, p_axion, step, calc_sf, action%pfermi(ipf))
              p_done=p_done+1
           endif
        endif
     endif
  enddo

  if (input%hmc_dsd == i) then
     call dsd(p, p_axion, step)       ; p_done = p_done + 1
  endif
  
  endif ! switches%dynamical

  if (input%hmc_dsg == i) then
     call dsg(p, gauge(1)%u, action%plaq, step); p_done = p_done + 1
     call dsg_qed(p_qed, conf%a_qed, step, para%beta_qed)
     call dsk_axion(p_axion, conf%axion, step, para%kappa_axion)
  endif
  if (input%hmc_dsig == i) then
     call dsig(p, gauge(1)%u, action%impg, step); p_done = p_done + 1
  endif

  if (p_done == 0) then
     write(msg, '(a, i1)') &
          "hmc_inte_p_control : didn't do anything at scale ", i
     call warn(msg)
     call die(msg)
  endif

  TIMING_STOP(timing_bin_hmc_steps)
  DEBUG2S("End: hmc_inte_p_control")

end subroutine hmc_inte_p_control

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