!===============================================================================
!
! dirac_matrix.F90
!
! make Dirac operator as matrix form,
! matrix shape for parallel computing is (12, volume/NPE, 12, volume)
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2011 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 check_eoprecmat(id)
  use module_field
  use module_action
  use module_vol
  implicit none
  integer, intent(in) :: id
  SPINCOL_FIELD :: eta, tmp, zeta1, zeta2
  COMPLEX,allocatable :: mat(:,:)
  integer :: i, ic, is
  COMPLEX :: ctmp
  REAL :: abs


  call stderr2("Now check mat-vec mult")

  allocate(mat(12*volh, 12*volh))

  call make_source(eta, tmp, RANDOM_SOURCE) ! tmp is dummy
!eta=0
!eta(1,1,1)=ONE
  !
  ! result multiplied by using d
  !
  call d(so, se,  tmp, eta, gauge(2)%u(1,1,1,0,1))
  call clover_mult_ao(clover(action%mtilde(id)%cid)%cfield%a(1,1,so),  tmp, volh)
  call d(se, so,zeta1, tmp, gauge(2)%u(1,1,1,0,1))
  call clover_mult_ao(clover(action%mtilde(id)%cid)%cfield%a(1,1,se),zeta1, volh)

!  call sc_xpby(zeta_o, eta_o, - action%mtilde(id)%kappa)



  call make_eoprec_op(mat, id)
  call matvec_mul(mat, zeta2, eta, 12*volh, 12*volh)

!do ic= 1,3
!do is= 1,4
!do i = 1, volh
!   ctmp = zeta1(ic,is,i) - zeta2(ic,is,i)
!   abs= real(ctmp) * real(ctmp) + imag(ctmp) * imag(ctmp) 
!   if (abs > 0.000001)   write(0,*)i,ic, is, zeta1(ic,is,i),zeta2(ic,is,i)
!enddo
!enddo
!enddo

  call compare_sc(zeta1, zeta2, 24*volh)

  deallocate(mat)
  call comm_finalize()
  call die("stop")
end

!-------------------------------------------------------------------------------
subroutine gamma_u(mat, j, i, eo, mu, fb, fac)
  use module_nn
  use module_field
  use module_dirac_matrix
  implicit none
  COMPLEX, intent(out) :: mat(4,3,4,3)
  integer, intent(out) :: j
  integer, intent(in) :: i, eo, mu, fb
  REAL, intent(in) :: fac
  integer :: s1, s2, c1, c2
  COMPLEX :: u(3,3), g(4,4)

  j = nn(i, eo, mu, fb) ! target site
  mat=0

  if (fb == FWD) then
     select case (mu)
        case(1); g = proj_1_p_gamma1
        case(2); g = proj_1_p_gamma2
        case(3); g = proj_1_p_gamma3
        case(4); g = proj_1_m_gamman
     end select
     u = gauge(2)%u(1:3, 1:3, i, eo, mu)
  else
     select case (mu)
        case(1); g=proj_1_m_gamma1
        case(2); g=proj_1_m_gamma2
        case(3); g=proj_1_m_gamma3
        case(4); g=proj_1_p_gamman
     end select
     do c1 = 1, 3
     do c2 = 1, 3
        u(c1, c2) = conjg(gauge(2)%u(c2, c1, j, 1-eo, mu))
     enddo
     enddo
  endif

  do s1 = 1, 4
  do s2 = 1, 4
     if ( g(s1, s2) /=0 ) then
        do c1 = 1, 3
        do c2 = 1, 3
           mat(s1,c1,s2,c2)=fac*u(c1,c2)*g(s1,s2)
        enddo
        enddo
     endif
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine put_lmat(lmat, gmat, i1, i2, v1, v2)
  implicit none
  integer, intent(in) :: i1, i2, v1, v2
  COMPLEX, intent(inout) :: gmat(12, v1, 12, v2)
  COMPLEX, intent(in) :: lmat(12, 12)
  integer :: sc1, sc2

  do sc1 = 1, 12
  do sc2 = 1, 12
     gmat(sc1, i1, sc2, i2) = lmat(sc1, sc2)
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine get_lmat(lmat, gmat, i1, i2, v1, v2)
  implicit none
  integer, intent(in) :: i1, i2, v1, v2
  COMPLEX, intent(in) :: gmat(12, v1, 12, v2)
  COMPLEX, intent(out) :: lmat(12, 12)
  integer :: sc1, sc2

  do sc1 = 1, 12
  do sc2 = 1, 12
     lmat(sc1, sc2) = gmat(sc1, i1, sc2, i2)
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine make_eoprec_op(gmat, id)
  use module_vol
  use module_field
  use module_action
  use module_function_decl
  implicit none
  integer, intent(in) :: id
  COMPLEX,intent(out) :: gmat(12, volh, 12, volh)
  COMPLEX :: lmat(12, 12), gmat1(12, volh, 12, volh), gmat2(12, volh, 12, volh), gmat3(12, volh, 12, volh)
  REAL :: kappa
  integer :: i, j, k, eo, mu, fb
  integer, dimension (volh, volh) :: struct0, struct1, struct2
  COMPLEX :: one,zero
  integer :: info, n, sc

  one =(1.0d0,0.0d0)
  zero=(0.0d0,0.0d0)

  call init_dirac_matrix()
  kappa=action%mtilde(id)%kappa

  gmat=ZERO
  gmat1=ZERO
  gmat2=ZERO
  gmat3=ZERO

!!  offset =  my_pe()*vol
!!  if (action%mtilde(id)%cswkappa == 0) then
!!     call one_put(mat, vol, volume, offset)
!!  else
!!     call clover_put(mat, EVEN, clover(action%mtilde(id)%cid)%a(1,1,se), offset)
!!     call clover_put(mat, ODD,  clover(action%mtilde(id)%cid)%a(1,1,so), offset)
!!  endif

  struct0=0
  struct1=0
  struct2=0
  !
  ! Doe
  !
  do i = 1, volh
  do fb = FWD, BWD
  do mu = 1, 4
     call gamma_u(lmat, j, i, so, mu, fb, ONE)
     call put_lmat(lmat, gmat1, i, j, volh, volh)
     struct0(i,j) = 1
  enddo
  enddo
  enddo
  do i = 1, volh
     do j = 1, volh
        if (struct0(i,j)==1) then
!           call get_lmat(lmat, gmat1, i, j, volh, volh)
           !
           ! 12 times backward substitution for clover inversion
           !
           do sc = 1, 12
!              call clover_mult_ao_block( & 
!              clover(action%mtilde(id)%cid)%i(1,i,so), lmat(1,sc), 1,1)
           enddo
           call put_lmat(lmat, gmat1, i, j, volh, volh)
        endif
     enddo
  enddo


  !
  ! Deo
  !
  do i = 1, volh
  do fb = FWD, BWD
  do mu = 1, 4
     call gamma_u(lmat, j, i, se, mu, fb, ONE)
     call put_lmat(lmat, gmat2, i, j, volh, volh)
     struct1(i,j) = 1
  enddo
  enddo
  enddo
  do i = 1, volh
     do j = 1, volh
        if (struct1(i,j)==1) then
!           call get_lmat(lmat, gmat2, i, j, volh, volh)
           !
           ! 12 times backward substitution for clover inversion
           !
           do sc = 1, 12
!              call clover_mult_ao_block( & 
!              clover(action%mtilde(id)%cid)%i(1,i,se), lmat(1,sc), 1,1)
           enddo
           call put_lmat(lmat, gmat2, i, j, volh, volh)
        endif
     enddo
  enddo

  n=12*volh
#ifdef LAPACK
  call zgemm('N','N', n, n, n, one, gmat2, n, gmat1, n, zero, gmat3, n)
#else
  call die("make_eoprec_op: requires LAPACK")
#endif

  gmat=gmat3

!  do i = 1, volh
!  do j = 1, volh
!     if (struct0(i,j) /= struct1(i,j) ) write(0,*)"different matrix structure:", i,j, struct0(i,j), struct1(i,j)
!  enddo
!  enddo

  do i = 1, volh
  do j = 1, volh
  do k = 1, volh
     if ( struct1(i,k) * struct0(k,j) == 1) then
        struct2(i,j) = 1
        exit
     endif
  enddo
  enddo
  enddo

!!  n = 12
!!  do i = 1, volh
!!     call get_clover(lmat1, i, id)
!!     do j = 1, volh
!!        if (struct0(i,j) == 1) then
!!           call get_lmat(lmat2, gmat, i, j, volh, volh)
!!#ifdef LAPACK
!!           call zgemm('N','N', n, n, n, one, lmat1, n, lmat2, n, zero, lmat3, n)
!!#else
!!           call die("make_eoprec_op: requires LAPACK")
!!#endif
!!           call put_lmat(lmat3, gmat, i, j, volh, volh)
!!        endif
!!     enddo
!!  enddo

end

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