!===============================================================================
!
! su3_2.F90  -  routines for su3 matrix
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007 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 u_zero(u)
  implicit none
  SU3, intent(inout) :: u

  u(1, 1) = ZERO;  u(2, 1) = ZERO;  u(3, 1) = ZERO
  u(1, 2) = ZERO;  u(2, 2) = ZERO;  u(3, 2) = ZERO
  u(1, 3) = ZERO;  u(2, 3) = ZERO;  u(3, 3) = ZERO
end
!-------------------------------------------------------------------------------
subroutine u_dag(u)  ! u: inout
  implicit none
  SU3 :: u,tmp
  integer :: i,j

  tmp = u
  do j = 1, NCOL
     do i = 1, NCOL
        u(i,j) = conjg(tmp(j,i))
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_i_times(u)
  implicit none
  SU3 :: u
  integer :: i,j
  COMPLEX :: i_times, c
  i_times(c) = cmplx(-aimag(c), real(c), kind = RKIND)

  do j = 1, NCOL
     do i = 1, NCOL
        u(i,j) = i_times(u(i,j))
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_scale(u, a)
  implicit none
  SU3 :: u
  REAL :: a
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        u(i,j) = a * u(i, j)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_scale_c(u, a)
  implicit none
  SU3 :: u
  COMPLEX :: a
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        u(i,j) = a * u(i, j)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_sub(inout, in)
  implicit none
  SU3 :: inout, in
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        inout(i,j) = inout(i,j) - in(i, j)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_sub2(out, in1, in2)  ! out: = in1 - in2
  implicit none
  SU3 :: out, in1 ,in2
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        out(i,j) = in1(i,j) - in2(i, j)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_scale_sub(inout, in, a)
  implicit none
  SU3 :: inout, in
  REAL :: a
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        inout(i,j) = inout(i,j) - a * in(i, j)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_scale_add(inout, in, a)
  implicit none
  SU3 :: inout, in
  REAL :: a
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        inout(i,j) = inout(i,j) + a * in(i, j)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine u_ppmm(out, in1,in2,in3,in4)
  implicit none
  SU3 :: out, in1,in2,in3,in4
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        out(i,j) = in1(i, j) + in2(i, j) - in3(i, j) - in4(i, j)
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine traceless(inout)
  implicit none
  SU3 :: inout
  COMPLEX :: tr
  integer :: i,j

  tr = (inout(1,1) + inout(2,2) + inout(3,3)) / THREE
  do i = 1, NCOL
     inout(i, i) = inout(i, i) - tr
  enddo

end

!-------------------------------------------------------------------------------
subroutine hermitian(out, in)
  implicit none
  SU3 :: in, out
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        out(i, j) = in(i, j) + conjg(in(j, i))
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine antihermitian(out, in)
  implicit none
  SU3 :: in, out
  integer :: i,j

  do j = 1, NCOL
     do i = 1, NCOL
        out(i, j) = in(i, j) - conjg(in(j, i))
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine traceless_hermit(out, in)
  implicit none
  SU3 :: in, out

  call hermitian(out, in)
  call traceless(out)
end

!-------------------------------------------------------------------------------
subroutine traceless_antihermit(out, in)
  implicit none
  SU3 :: in, out

  call antihermitian(out, in)
  call traceless(out)
end

!-------------------------------------------------------------------------------
subroutine a_a1xm1_a2xm2(u,a1,a2,f)

  implicit none

  SU3, intent(out)   :: u
  SU3, intent(in)    :: a1, a2
  COMPLEX,intent(in) :: f(3)

  integer :: i, j

  do j = 1, NCOL
     do i = 1, NCOL
        u(i, j) = f(2) * a1(i, j) + f(3) * a2(i, j)
     enddo
  enddo

  do i = 1, NCOL
     u(i, i) = u(i, i) + f(1)
  enddo

end

!-------------------------------------------------------------------------------
COMPLEX function Tr_uu(a, b)

  implicit none
  SU3, intent(in) :: a, b
  integer :: i

  Tr_uu = ZERO

  do i = 1, NCOL
     Tr_uu = Tr_uu + a(i, 1) * b(1, i) &
                   + a(i, 2) * b(2, i) &
                   + a(i, 3) * b(3, i)
  enddo

end

!-------------------------------------------------------------------------------
subroutine transposition_su3(out,in)

  implicit none

  SU3,     intent(out) :: out
  SU3,     intent(in)  :: in

  integer :: ic ,jc

  do ic = 1, NCOL
     do jc = 1, NCOL
        out(jc, ic) = in(ic ,jc)
     enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine transposition_gauge(out,in)

  use module_vol
  implicit none

  GAUGE_FIELD,     intent(out) :: out
  GAUGE_FIELD,     intent(in)  :: in

  integer :: i,eo,mu

  do mu = 1, DIM
     do eo = EVEN, ODD
        !$omp parallel do
        do i = 1, VOLH
           call transposition_su3(out(1,1,i,eo,mu), in(1,1,i,eo,mu))
        enddo
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine make_q1(out, in, a)

  implicit none

  REAL,intent(in)  :: a
  SU3, intent(in)  :: in
  SU3, intent(out) :: out

  SU3              :: tmp

  tmp = in
  call u_scale(tmp, a)
  call u_i_times(tmp)
  call traceless_hermit(out, tmp)

end

!-------------------------------------------------------------------------------
subroutine gen2tlhermit(tlh, g) ! lambda_i g_i

  use module_vol
  implicit none

  GENERATOR, intent(in) :: g
  GENERATOR :: gh
  SU3, intent(out) :: tlh

!  gh = g * HALF

  tlh(1,1) = cmplx( g(3) + g(8)/SQRT3, ZERO, RKIND)
  tlh(2,2) = cmplx(-g(3) + g(8)/SQRT3, ZERO, RKIND)
  tlh(3,3) = cmplx(- TWO * g(8)/SQRT3, ZERO, RKIND)

  tlh(1,2) = cmplx(g(1) , -g(2) ,RKIND)
  tlh(1,3) = cmplx(g(4) , -g(5) ,RKIND)
  tlh(2,3) = cmplx(g(6) , -g(7) ,RKIND)

  tlh(2,1) = conjg(tlh(1,2))
  tlh(3,1) = conjg(tlh(1,3))
  tlh(3,2) = conjg(tlh(2,3))

end

!-------------------------------------------------------------------------------
subroutine force_to_p(p, s, u, uuu) ! u->conf%u, uuu ->staple or something

  use module_vol
  use module_switches
  implicit none

  GENERATOR_FIELD, intent(inout) :: p
  GAUGE_FIELD,     intent(in)    :: u, uuu
  REAL,            intent(in)    :: s

  integer                        :: mu, eo, i
  SU3 :: w

  !!if (switches%qed) then
  !!   p = ZERO
  !!   return
  !!endif

  do mu = 1, DIM
     do eo = EVEN, ODD
        !$omp parallel do private(w)
        do i = 1, volh
           call uu(w, u(1, 1, i, eo, mu), uuu(1, 1, i, eo, mu))
           call im_tr_j(p(1, i, eo, mu), w, s)
        enddo
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine gen_m_force(p, force, u)
  use module_vol
  use module_switches
  implicit none

  GENERATOR_FIELD, intent(inout) :: p
  GAUGE_FIELD, intent(in) :: force, u
  integer :: mu, eo, i
  SU3 :: w

  !!if (switches%qed) then
  !!   p = ZERO
  !!   return
  !!endif

  if (switches%boundary_sf) call schr_boundary_zero3(force)

  do mu = 1, DIM
     do eo = EVEN, ODD
        !$omp parallel do private(w)
        do i = 1, volh
           call uu(w, u(1, 1, i, eo, mu), force(1, 1, i, eo, mu))
           call im_tr_jm1(p(1, i, eo, mu), w)
        enddo
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine gauge_add(inout, in) ! inout = inout + in

  use module_vol
  implicit none

  GAUGE_FIELD, intent(inout) :: inout
  GAUGE_FIELD, intent(in)    :: in

  integer                        :: mu, eo, i

  do mu = 1, DIM
     do eo = EVEN, ODD
        !$omp parallel do
        do i = 1, volh
           call u_add(inout(1, 1, i, eo, mu), in(1, 1,  i, eo, mu))
        enddo
     enddo
  enddo

end

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