!===============================================================================
!
! action.F90 - calculation of actions
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-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/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
!!REAL function sf(para, conf)  ! returns S_f                     OLD
!!
!!  use typedef_hmc
!!  use module_p_interface
!!  use module_vol
!!  implicit none
!!
!!  type(hmc_para), intent(in) :: para
!!  type(hmc_conf), intent(in) :: conf
!!
!!  P_SPINCOL_FIELD, save :: a, b
!!
!!  REAL, external  :: dotprod, clover_action
!!  integer         :: iterations
!!
!!  if (para%kappa == ZERO) then
!!     sf = ZERO
!!  else
!!     ALLOCATE_SC_FIELD(a)
!!     ALLOCATE_SC_FIELD(b)
!!     
!!     call flip_bc(conf%u)
!!
!!     call sc_copy(a, conf%phi)                                 ! A = phi
!!
!!     call cg(CG_MATRIX_M, a, conf%phi, para, conf, iterations) ! A = inv(M~+ M~) Phi
!!     call mtil(b, a, para, conf)                               ! B = M~ A
!!
!!     sf = dotprod(b, b, SIZE_SC_FIELD)
!!
!!     call flip_bc(conf%u)
!!  endif
!!
!!  if (para%csw_kappa /= ZERO) sf = sf + clover_action(conf%b(1,1,ODD))
!!end
!!
!-------------------------------------------------------------------------------
REAL function sg(u)  ! returns S_g

  use module_nn
  use module_vol
  implicit none

  GAUGE_FIELD :: u
  REAL :: plaq, global_sum, p
  SU3 :: uuu
  integer :: i, e, o, mu, nu, j1, j2
  REAL, external :: Re_Tr_uu

  TIMING_START(timing_bin_plaq)

  plaq = ZERO

  do mu = 1, DIM
     do e = EVEN, ODD
        o = EVEN + ODD - e
        do nu = mu + 1, DIM
           p = ZERO
           !$omp parallel do reduction(+: p) private(j1, j2, uuu)
           do i = 1, volh

              !  (j2,o) --<--   x        nu
              !    |            |        
              !    v            ^         ^
              !    |            |         |
              !  (i,e)  -->-- (j1,o)      x-->  mu


              j1 = nn(i, e, mu, FWD)
              j2 = nn(i, e, nu, FWD)
              
              uuu = ZERO
              call uuu_fwd(uuu, u(1, 1, j1, o, nu), &
                                u(1, 1, j2, o, mu), &
                                u(1, 1, i, e, nu))

              p = p + Re_Tr_uu(uuu, u(1, 1, i, e, mu))
           enddo
           plaq = plaq + p
        enddo
     enddo
  enddo
              
  plaq = global_sum(plaq)

  sg = (6 * volume) - plaq / THREE  ! missing factor beta

  TIMING_STOP(timing_bin_plaq)

end

!-------------------------------------------------------------------------------
REAL function sg_qed(a, plaquette)  ! returns S_G^QED and average plaquette

  use module_nn
  use module_vol
  use module_switches
  implicit none

  U1_GENERATOR_FIELD, intent(in) :: a
  REAL, intent(out)              :: plaquette
  
  REAL :: plaq, global_sum, p
  integer :: i, e, o, mu, nu, j1, j2


  if (.not. switches%qed) then
     sg_qed = ZERO
     plaquette = ZERO
     return
  endif

  plaq = ZERO

  do mu = 1, DIM
     do e = EVEN, ODD
        o = EVEN + ODD - e
        do nu = mu + 1, DIM
           p = ZERO
           !$omp parallel do reduction(+: p) private(j1, j2)
           do i = 1, volh

              !  (j2,o) --<--   x        nu
              !    |            |        
              !    v            ^         ^
              !    |            |         |
              !  (i,e)  -->-- (j1,o)      x-->  mu

              j1 = nn(i, e, mu, FWD)
              j2 = nn(i, e, nu, FWD)
              
              p = p + (a(i, e, mu) &
                     + a(j1, o, nu) &
                     - a(j2, o, mu) &
                     - a(i, e, nu))**2
           enddo
           plaq = plaq + p
        enddo
     enddo
  enddo
              
  plaq = global_sum(plaq)

  sg_qed = plaq * HALF  ! missing factor beta_qed
  plaquette = sg_qed / (SIX * VOLUME)
end

!-------------------------------------------------------------------------------
REAL function sp(p)  ! returns action of momenta p

  use module_vol
  use module_function_decl
  implicit none
  GENERATOR_FIELD, intent(in) :: p
  
  integer :: mu, eo
  
  sp = ZERO
  do mu = 1, DIM
     do eo = EVEN, ODD
        sp = sp + dotprod(p(1, 1, eo, mu), p(1, 1, eo, mu), NGEN * volh)
     enddo
  enddo
  sp = sp * HALF

end

!-------------------------------------------------------------------------------
REAL function sp_qed(p)  ! returns action of momenta p_qed

  use module_vol
  use module_function_decl
  use module_switches
  implicit none
  U1_GENERATOR_FIELD, intent(in) :: p
  
  integer :: mu, eo
  
  if (.not. switches%qed) then
     sp_qed = ZERO
     return
  endif

  sp_qed = ZERO
  do mu = 1, DIM
     do eo = EVEN, ODD
        sp_qed = sp_qed + dotprod(p(1, eo, mu), p(1, eo, mu), volh)
     enddo
  enddo
  sp_qed = sp_qed * HALF

end

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