!===============================================================================
!
! clover12.F90 - calculates clover matrix and its inverse
!                         flexible term including version
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-2003 Hinnerk Stueben
! Copyright (C) 2007, 2008 2012 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"
# include "clover12.h"

!-------------------------------------------------------------------------------
subroutine clover_init12(a, ainv, det, u, csw_kappa, lambda_kappa, finv_axion)
  use typedef_clover
  use module_vol
  use module_switches
  use module_field
  implicit none

  CLOVER_FIELD12, intent(out) :: a, ainv
  COMPLEX, dimension(volh, 0:1), intent(out) :: det
  GAUGE_FIELD,    intent(in)  :: u
  REAL,           intent(in)  :: csw_kappa, lambda_kappa, finv_axion

  integer             :: i, eo, mu1(6), mu2(6)
  SU3                 :: f, g
  type(type_clover_a) :: p, q
  REAL                :: factor(EVEN:ODD, volh)
  REAL                :: lamkap(volh, EVEN:ODD)

  DEBUG2S("Start: clover_init12")
!!  TIMING_START(timing_bin_clover_init)

  factor = -csw_kappa / EIGHT
  if (switches%boundary_sf) call schrfunc_cswkappa(factor)

#ifdef GAMMA_NOTATION_CHROMA
  mu1(1)=1  ; mu1(2)=2
  mu1(3)=2  ; mu1(4)=3
  mu1(5)=3  ; mu1(6)=1
  mu2(1)=4  ; mu2(2)=3
  mu2(3)=4  ; mu2(4)=1
  mu2(5)=4  ; mu2(6)=2
#elif defined GAMMA_NOTATION_CHIRAL
  mu1(1)=2  ; mu1(2)=1
  mu1(3)=3  ; mu1(4)=2
  mu1(5)=3  ; mu1(6)=1
  mu2(1)=3  ; mu2(2)=4
  mu2(3)=1  ; mu2(4)=4
  mu2(5)=4  ; mu2(6)=2
#elif defined GAMMA_NOTATION_DDHMC
  mu1(1)=2  ; mu1(2)=1
  mu1(3)=3  ; mu1(4)=2
  mu1(5)=3  ; mu1(6)=1
  mu2(1)=4  ; mu2(2)=3
  mu2(3)=4  ; mu2(4)=1
  mu2(5)=2  ; mu2(6)=4
#else
  mu1(1)=2  ; mu1(2)=1
  mu1(3)=3  ; mu1(4)=2
  mu1(5)=3  ; mu1(6)=1
  mu2(1)=3  ; mu2(2)=4
  mu2(3)=1  ; mu2(4)=4
  mu2(5)=4  ; mu2(6)=2
#endif

  if (finv_axion /= ZERO) then
     do eo = EVEN, ODD
        !$omp parallel do
        do i = 1, VOLH
           lamkap(i, eo) = lambda_kappa + axion_ptr(i, eo) * finv_axion
        enddo
     enddo
  else
     do eo = EVEN, ODD
        !$omp parallel do
        do i = 1, VOLH
           lamkap(i, eo) = lambda_kappa
        enddo
     enddo
  endif

  do eo = EVEN, ODD
     !$omp parallel do private(f, g, p, q)
     do i = 1, VOLH
        call clover_f_mu_nu_imp(f, mu1(1), mu1(2), i, eo, u) !  F21 = i(f21 - f21^{+}) [3x3]
        call clover_init1(p, f)                            !  FF1
        call clover_f_mu_nu_imp(f, mu1(3), mu1(4), i, eo, u) !  F32 = i(f32 - f32^{+}) [3x3]
        call clover_f_mu_nu_imp(g, mu1(5), mu1(6), i, eo, u) !  F31 = i(f31 - f31^{+}) [3x3]
        call clover_init2(p, f, g)                         !  FF2
        call clover_f_mu_nu_imp(f, mu2(1), mu2(2), i, eo, u) !  F34 = i(f34 - f34^{+}) [3x3]
        call clover_init1(q, f)                            !  FF3
        call clover_f_mu_nu_imp(f, mu2(3), mu2(4), i, eo, u) !  F14 = i(f14 - f14^{+}) [3x3]
        call clover_f_mu_nu_imp(g, mu2(5), mu2(6), i, eo, u) !  F42 = i(f42 - f42^{+}) [3x3]
        call clover_init2(q, f, g)                         !  FF4
        call clover_init3_12(a(i, eo), p, q, factor(eo, i), lamkap(i, eo))
     enddo
  enddo
  !! here must be single thread, since inside functions is multi-threaded
  do eo = EVEN, ODD
     do i = 1, VOLH
        call matrix_inv_12(ainv(i, eo)%i, det(i, eo), a(i, eo)%i)
     enddo
  enddo

!!  TIMING_STOP(timing_bin_clover_init)
  DEBUG2S("End: clover_init")
end

!-------------------------------------------------------------------------------
subroutine clover_init3_12(a, p, q, s, lk)
  use module_action
  use typedef_clover
  implicit none
  type(type_clover12) :: a
  type(type_clover_a) :: p, q
  REAL                :: s, lk
  integer :: i, j, i1, i2, i3, j1, j2, j3

  ! fill right upper of  left upper
  ! + + - -
  ! - + - -
  ! - - - -
  ! - - - -
  a%i( 1, 1) = s * p%i11
  a%i( 1, 2) = s * p%i12
  a%i( 1, 3) = s * p%i13
  a%i( 1, 4) = s * p%i14
  a%i( 1, 5) = s * p%i15
  a%i( 1, 6) = s * p%i16
  a%i( 2, 2) = s * p%i22
  a%i( 2, 3) = s * p%i23
  a%i( 2, 4) = s * p%i24
  a%i( 2, 5) = s * p%i25
  a%i( 2, 6) = s * p%i26
  a%i( 3, 3) = s * p%i33
  a%i( 3, 4) = s * p%i34
  a%i( 3, 5) = s * p%i35
  a%i( 3, 6) = s * p%i36
  a%i( 4, 4) = s * p%i44
  a%i( 4, 5) = s * p%i45
  a%i( 4, 6) = s * p%i46
  a%i( 5, 5) = s * p%i55
  a%i( 5, 6) = s * p%i56
  a%i( 6, 6) = s * p%i66

  ! fill right upper of right upper
  ! - - + +
  ! - - - +
  ! - - - -
  ! - - - -
  a%i( 1, 7) = s * q%i11
  a%i( 1, 8) = s * q%i12
  a%i( 1, 9) = s * q%i13
  a%i( 1,10) = s * q%i14
  a%i( 1,11) = s * q%i15
  a%i( 1,12) = s * q%i16
  a%i( 2, 8) = s * q%i22
  a%i( 2, 9) = s * q%i23
  a%i( 2,10) = s * q%i24
  a%i( 2,11) = s * q%i25
  a%i( 2,12) = s * q%i26
  a%i( 3, 9) = s * q%i33
  a%i( 3,10) = s * q%i34
  a%i( 3,11) = s * q%i35
  a%i( 3,12) = s * q%i36
  a%i( 4,10) = s * q%i44
  a%i( 4,11) = s * q%i45
  a%i( 4,12) = s * q%i46
  a%i( 5,11) = s * q%i55
  a%i( 5,12) = s * q%i56
  a%i( 6,12) = s * q%i66

  ! fill left lower of right upper
  ! - - - -
  ! - - + -
  ! - - - -
  ! - - - -
  do i = 1, 6
     do j = 1, i - 1
        a%i(i,j+6) = conjg(a%i(j,i+6))
     enddo
  enddo

  ! fill right upper of right lower
  ! - - - -
  ! - - - -
  ! - - + +
  ! - - - +
  do i = 1, 6
     do j = i, 6
        a%i(i+6, j+6) = a%i(i, j)
     enddo
  enddo

  ! fill right upper of right lower and add one to diag
  ! 1 - - -
  ! + 1 - -
  ! + + 1 -
  ! + + + 1
  do i = 1, 12
     a%i(i,i) = a%i(i,i) + ONE
     do j = 1, i - 1
        a%i(i,j) = conjg(a%i(j,i))
     enddo
  enddo

  do i = 1, 4
  do j = 1, 4
     i1= 1 + 3*(i-1)
     i2= 2 + 3*(i-1)
     i3= 3 + 3*(i-1)
     j1= 1 + 3*(j-1)
     j2= 2 + 3*(j-1)
     j3= 3 + 3*(j-1)
     a%i(i1,j1) = a%i(i1,j1) + lk * breaking_term(i,j)
     a%i(i2,j2) = a%i(i2,j2) + lk * breaking_term(i,j)
     a%i(i3,j3) = a%i(i3,j3) + lk * breaking_term(i,j)
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine matrix_inv_12(out, det, in)
  use typedef_clover
  implicit none
  COMPLEX, intent(in) :: in(12,12)
  COMPLEX, intent(out):: out(12,12), det
  COMPLEX :: work(2*12), ipiv(12), tmp(12,12)
  integer :: info, i, count, j, k

#ifdef LAPACK
  out = in
  call zgetrf(12, 12, out, 12, ipiv, info)

  count = 0
  det = ONE
  do i = 1, 12
     det = det * out(i,i)
     if(i /= ipiv(i)) count = count + 1
  enddo
  if (mod(count, 2) == 1) det = - det
  call zgetri(12, out, 12, ipiv, work, 12 ,info)

  if ( info /= 0) call die("clover_inv_12 failed to invert")
#else
  call die("matrix_inv_12 needs LAPACK")
#endif

!! inversion check
!!  tmp=0
!!  do i = 1, 12
!!  do j = 1, 12
!!  do k = 1, 12
!!     tmp(i,j) = tmp(i,j) + in(i,k)*out(k,j)
!!  enddo
!!  enddo
!!  enddo
!!
!!  write(0,*)"================================="
!!  do i=1,12
!!     write(0,'(24f7.3)')  (Re(in(i,j)), Im(in(i,j)), j = 1, 12)
!!  enddo
!!
!!  write(0,*)"================================="
!!  do i=1,12
!!     write(0,'(24f7.3)')  (Re(out(i,j)), Im(out(i,j)), j = 1, 12)
!!  enddo
!!
!!  write(0,*)"================================="
!!  do i=1,12
!!     write(0,'(24f7.3)')  (Re(tmp(i,j)), Im(tmp(i,j)), j = 1, 12)
!!  enddo
!!
!!stop

end

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