!===============================================================================
!
! hmc_genr.F90 -- generalized integration schemes
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2008 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/>.
!
!-------------------------------------------------------------------------------
! Author: Taylor Haar
! Last modified: 16/03/2017
!-------------------------------------------------------------------------------
# include "defs.h"

! All the generalized integrators herein are expressed via two arrays:
! - step_q = steps to change P (via force terms)
! - step_ps = steps to change U/Q (via e^iP)
! The subroutines construct these arrays such that,
! in the single integrator case, alternating between
! Q updates and P updates produce the actual scheme.
!
! When dealing with multiple integration schemes, we need to
! merge the Q updates 'step_ps' together into a linear scheme,
! which is performed by uber_gen_meld() in integrator.F90.
! The full integrator is then enacted by alternating between Q updates
! (on the merged timeline) and P updates (for *each* action term).

!-------------------------------------------------------------------------------
subroutine hmc_lpfsts_genintegrator(this_scale)
  use module_integrator
  implicit none
  integer, intent(in) :: this_scale
  REAL :: h
  integer :: n, itau

  itau = 0
  h = len / scale(this_scale)

  if(this_scale > n_time_scale) call die("scale>n_time_scale")

  do n = 1, scale(this_scale)
     step_q(itau, this_scale) = step_q(itau, this_scale) + h * HALF
     itau = itau + 1
     step_ps(itau, this_scale) = step_ps(itau,this_scale) + h
     step_q(itau, this_scale) = step_q(itau, this_scale) + h * HALF
  enddo

end subroutine hmc_lpfsts_genintegrator

!-------------------------------------------------------------------------------
subroutine hmc_lpftst_genintegrator(this_scale)
  use module_integrator
  implicit none
  integer, intent(in) :: this_scale
  REAL :: h
  integer :: n, itau

  itau = 0
  h = len / scale(this_scale)

  if(this_scale > n_time_scale) call die("scale>n_time_scale")

  do n = 1, scale(this_scale)
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * HALF
     step_q(itau,this_scale) = step_q(itau,this_scale) + h
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau, this_scale) + h * HALF
  enddo

end subroutine hmc_lpftst_genintegrator

!-------------------------------------------------------------------------------
subroutine hmc_2mnsts_genintegrator(this_scale)
  use module_integrator
  implicit none
  REAL, parameter :: lambda = 0.1931833275037836_8
  REAL, parameter :: one_two_lambda = ONE - TWO * lambda
  integer, intent(in) :: this_scale
  REAL :: h
  integer :: n, itau

  itau = 0
  h = len / scale(this_scale)

  if(this_scale > n_time_scale) call die("scale>n_time_scale")

  do n = 1, scale(this_scale)
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * lambda
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * HALF
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * one_two_lambda
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * HALF
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * lambda
  enddo

end subroutine hmc_2mnsts_genintegrator

!-------------------------------------------------------------------------------
subroutine hmc_2mntst_genintegrator(this_scale)
  use module_integrator
  implicit none
  REAL, parameter :: lambda = 0.1931833275037836_8
  REAL, parameter :: one_two_lambda = ONE - TWO * lambda
  integer, intent(in) :: this_scale
  REAL :: h
  integer :: n, itau

  itau = 0
  h = len / scale(this_scale)

  if(this_scale > n_time_scale) call die("scale>n_time_scale")

  do n = 1, scale(this_scale)
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * lambda
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * HALF
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * one_two_lambda
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * HALF
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * lambda
  enddo

end subroutine hmc_2mntst_genintegrator

!-------------------------------------------------------------------------------
subroutine hmc_4mn5fv_genintegrator(this_scale)
  use module_integrator
  implicit none
  REAL, parameter :: theta =  0.08398315262876693_8
  REAL, parameter :: rho =     0.2539785108410595_8
  REAL, parameter :: lambda =  0.6822365335719091_8
  REAL, parameter :: mu =    -0.03230286765269967_8
  REAL, parameter :: hmlt = HALF-(lambda+theta)
  REAL, parameter :: omtmurho = ONE-TWO*(mu+rho)

  integer, intent(in) :: this_scale
  REAL :: h
  integer :: n, itau

  itau = 0
  h = len / scale(this_scale)

  if(this_scale > n_time_scale) call die("scale>n_time_scale")

  do n = 1, scale(this_scale)
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * theta
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * rho
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * lambda
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * mu
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * hmlt
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * omtmurho
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * hmlt
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * mu
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * lambda
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + h * rho
     step_q(itau,this_scale) = step_q(itau,this_scale) + h * theta
  enddo

end subroutine hmc_4mn5fv_genintegrator

!-------------------------------------------------------------------------------
subroutine hmc_4mn4fp_genintegrator(this_scale)
  use module_integrator
  implicit none
  REAL, parameter :: rho =      0.1786178958448091_8
  REAL, parameter :: theta =  -0.06626458266981843_8
  REAL, parameter :: lambda =   0.7123418310626056_8
  REAL, parameter :: one_minus_two_lambda_by2 = HALF-lambda
  REAL, parameter :: one_minus_two_theta_plus_rho = ONE-TWO*(theta+rho)

  integer, intent(in) :: this_scale
  REAL :: h
  integer :: n, itau

  itau = 0
  h = len / scale(this_scale)

  if(this_scale > n_time_scale) call die("scale>n_time_scale")

  do n = 1, scale(this_scale)
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + len * rho
     step_q(itau,this_scale) = step_q(itau,this_scale) + len * lambda
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + len * theta
     step_q(itau,this_scale) = step_q(itau,this_scale) &
          + len * one_minus_two_lambda_by2
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) &
          + len * one_minus_two_theta_plus_rho
     step_q(itau,this_scale) = step_q(itau,this_scale) &
          + len * one_minus_two_lambda_by2
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + len * theta
     step_q(itau,this_scale) = step_q(itau,this_scale) + len * lambda
     itau = itau + 1
     step_ps(itau,this_scale) = step_ps(itau,this_scale) + len * rho
  enddo

end subroutine hmc_4mn4fp_genintegrator

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