!===============================================================================
!
! traces.F90
!
! calculates: Tr(inv(M))          psibar psi (pbp)
!             Tr(gamma5 inv(M))   psibar gamma5 psi (p5p)
!             Tr(inv(M+ M))       pion norm  (pinorm)
!
! traces of a matrix A are calculated with a stochastic estimator:
!
!     Tr(A) = eta+ A eta  (eta: Gaussian noise)
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2000-2008 Hinnerk Stueben
!               2007-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"

!-------------------------------------------------------------------------------
subroutine traces(traj)
  use module_field
  use module_action
  use module_input
  use module_function_decl
  use module_p_interface
  use module_vol
  use module_cg
  implicit none

  integer, intent(in)  :: traj
  SPINCOL_FIELD :: eta_e, eta_o, zeta_e, zeta_o, tmpe, tmpo, tmp1e, tmp1o, dummye, dummyo
  SPINCOL_FIELD :: t0011e, t0011o
  SPINCOL_FIELD :: t0111e, t0111o
  SPINCOL_FIELD :: t1111e, t1111o
  SPINCOL_FIELD :: t0002e, t0002o
  SPINCOL_FIELD :: t0003e, t0003o
  SPINCOL_FIELD :: t0012e, t0012o
  SPINCOL_FIELD :: t0022e, t0022o
  SPINCOL_FIELD :: t0032e, t0032o
  SPINCOL_FIELD :: t0033e, t0033o
  SPINCOL_FIELD :: t0122e, t0122o
  SPINCOL_FIELD :: t0222e, t0222o
  SPINCOL_FIELD :: t0322e, t0322o
  SPINCOL_FIELD :: t2222e, t2222o
  SPINCOL_FIELD :: t0021e, t0021o
  SPINCOL_FIELD :: t0031e, t0031o
  SPINCOL_FIELD :: t0211e, t0211o
  SPINCOL_FIELD :: t0311e, t0311o
  SPINCOL_FIELD :: t2111e, t2111o
  SPINCOL_FIELD :: t0121e, t0121o
  SPINCOL_FIELD :: t0131e, t0131o
  SPINCOL_FIELD :: t0221e, t0221o
  SPINCOL_FIELD :: t0321e, t0321o
  SPINCOL_FIELD :: t0231e, t0231o
  SPINCOL_FIELD :: t2211e, t2211o
  SPINCOL_FIELD :: t2121e, t2121o
  SPINCOL_FIELD :: t2221e, t2221o

  character(len=*), parameter :: key_tr = "%tr ", key_trd= "%trd", key_trc= "%trc", key_trm = "%trm"
  character(len=15) :: key
  integer, save :: count = 0
  integer       :: size_of_trace, ncg, cgit, cgtot
  integer       :: fid, mid, i, j, nsrc, m, eo, iv, ic, is
  COMPLEX       :: ctmp(50), chemipt, ctmp11
  REAL          :: rtmp1, rtmp2
  COMPLEX, external :: trace_mudiv
  count = count + 1
  nsrc =input%measure_traces
  size_of_trace = NDIRAC * NCOL * volume
  chemipt = cmplx(chemi,chemi_i)

  call init_cg_stat(cg_stat)
  call init_imp_all(.true.)

!!call check_eoprecmat(1)
!!call quda_test(mid)

  do mid = 1, n_mtilde
     ctmp= ZERO
     do i=1,nsrc
        call make_source(eta_e, eta_o, RANDOM_SOURCE)

! free case check, four src is enough to check
!     nsrc=4
!     do i=1,nsrc
!        eta_e=0
!        eta_o=0
!        eta_e(i,1,1)=sqrt(dble(12*volume))

!!        tmpe=eta_e
!!        tmp1e=eta_e
!!   call clover_mult_a(tmpe, clover(action%mtilde(mid)%cid)%cfield%a(1,1,se), eta_e, volh)
!!   call breaking_mult(tmpo, clover(action%mtilde(mid)%cid)%lambdakappa,  eta_e, volh)
!!        tmpe = tmpe + tmpo
!!   call clover_mult_a12(tmp1e, clover(action%mtilde(mid)%cid)%cfield12%a(1,se), eta_e, volh)
!!   call compare_sc(tmpe, tmp1e, 24*vol)
!!   stop
        call solve(zeta_e, zeta_o, eta_e, eta_o, mid)  ! zeta = inv(M) eta  ! original
        rtmp1 = sc_dot(zeta_e, zeta_e) + sc_dot(zeta_o, zeta_o)   !! pinorm
        rtmp2 = sc_dot( eta_e,  eta_e) + sc_dot( eta_o,  eta_o)   !! eta^+ eta
        ctmp(1) = ctmp(1) + cmplx(rtmp1, rtmp2)
        ctmp(2) = ctmp(2) + sc_cdotc(eta_e, zeta_e) + sc_cdotc(eta_o, zeta_o) !! \bar{\psi} \psi
        call gamma5(zeta_e, volh)
        call gamma5(zeta_o, volh)
        ctmp(3) = ctmp(3) + sc_cdotc(eta_e, zeta_e) + sc_cdotc(eta_o, zeta_o) !! \bar{\psi} \gamma_5 \psi
        call gamma5(zeta_e, volh) ! zeta = inv(M) eta, againg
        call gamma5(zeta_o, volh) !
        if (action%mtilde(mid)%cswkappa /=0) then
           call unprec_cmul(tmpe, tmpo, zeta_e, zeta_o, mid)
           tmpe = tmpe - zeta_e
           tmpo = tmpo - zeta_o
           ctmp(4) = ctmp(4) + sc_cdotc(eta_e, tmpe) + sc_cdotc(eta_o, tmpo) !! \bar{\psi} C \psi
           do j = 1, 2
              call solve(tmp1e, tmp1o, tmpe, tmpo, mid)
              call unprec_cmul(tmpe, tmpo, tmp1e, tmp1o, mid)
              tmpe = tmpe - tmp1e
              tmpo = tmpo - tmp1o
              ctmp(4+j) = ctmp(4+j) + sc_cdotc(eta_e, tmpe) + sc_cdotc(eta_o, tmpo) !! \bar{\psi} C D^-1 C \psi
           enddo
        endif
        do j = 1, 3
           if (j==1) then
              tmp1e = zeta_e
              tmp1o = zeta_o
           else
              tmp1e = tmpe
              tmp1o = tmpo
           endif
           ctmp(6+j) = ctmp(6+j) + trace_mudiv(tmpe,   tmpo, eta_e, eta_o, tmp1e, tmp1o,  mid, 1, 0, chemipt) !! \bar{\psi} D^{-(1+j)} \psi

           if (j==1) then
              t0011e = tmpe
              t0011o = tmpo
           endif

           if (j==2) then
              t0111e = tmpe
              t0111o = tmpo
           endif

           if (j==3) then
              t1111e = tmpe
              t1111o = tmpo
           endif

        enddo

        !!if (chemi /=0 .or. chemi_i /=0) then
           ctmp(10) = ctmp(10) + trace_mudiv(t0002e, t0002o, eta_e, eta_o, zeta_e, zeta_o, mid, 0, 1, chemipt) !! Tr(       2 ) !
           ctmp(11) = ctmp(11) + trace_mudiv(t0003e, t0003o, eta_e, eta_o, zeta_e, zeta_o, mid, 0, 2, chemipt) !! Tr(       3 ) !
           ctmp(46) = ctmp(46) + trace_mudiv(t0012e, t0012o, eta_e, eta_o, t0002e, t0002o, mid, 1, 0, chemipt) !! Tr(     1 2 ) ! tmp
           ctmp(12) = ctmp(12) + trace_mudiv(t0022e, t0022o, eta_e, eta_o, t0012e, t0012o, mid, 0, 1, chemipt) !! Tr(     2 2 ) !
           ctmp(13) = ctmp(13) + trace_mudiv(t0032e, t0032o, eta_e, eta_o, t0012e, t0012o, mid, 0, 2, chemipt) !! Tr(     3 2 ) !
           ctmp(14) = ctmp(14) + trace_mudiv(t0033e, t0033o, eta_e, eta_o, t0003e, t0003o, mid, 1, 2, chemipt) !! Tr(     3 3 ) !
           ctmp(47) = ctmp(47) + trace_mudiv(t0122e, t0122o, eta_e, eta_o, t0022e, t0022o, mid, 1, 0, chemipt) !! Tr(   1 2 2 ) ! tmp
           ctmp(15) = ctmp(15) + trace_mudiv(t0222e, t0222o, eta_e, eta_o, t0122e, t0122o, mid, 0, 1, chemipt) !! Tr(   2 2 2 ) !
           ctmp(16) = ctmp(16) + trace_mudiv(t0322e, t0322o, eta_e, eta_o, t0122e, t0122o, mid, 0, 2, chemipt) !! Tr(   3 2 2 ) !
           ctmp(17) = ctmp(17) + trace_mudiv(t2222e, t2222o, eta_e, eta_o, t0222e, t0222o, mid, 1, 1, chemipt) !! Tr( 2 2 2 2 ) !
           ctmp(18) = ctmp(18) + trace_mudiv(t0021e, t0021o, eta_e, eta_o, t0011e, t0011o, mid, 0, 1, chemipt) !! Tr(     2 1 ) !
           ctmp(19) = ctmp(19) + trace_mudiv(t0031e, t0031o, eta_e, eta_o, t0011e, t0011o, mid, 0, 2, chemipt) !! Tr(     3 1 ) !
           ctmp(20) = ctmp(20) + trace_mudiv(t0211e, t0211o, eta_e, eta_o, t0111e, t0111o, mid, 0, 1, chemipt) !! Tr(   2 1 1 ) !
           ctmp(21) = ctmp(21) + trace_mudiv(t0311e, t0311o, eta_e, eta_o, t0111e, t0111o, mid, 0, 2, chemipt) !! Tr(   3 1 1 ) !
           ctmp(22) = ctmp(22) + trace_mudiv(t2111e, t2111o, eta_e, eta_o, t1111e, t1111o, mid, 0, 1, chemipt) !! Tr( 2 1 1 1 ) !
           ctmp(48) = ctmp(48) + trace_mudiv(t0121e, t0121o, eta_e, eta_o, t0021e, t0021o, mid, 1, 0, chemipt) !! Tr(   1 2 1 ) ! tmp
           ctmp(49) = ctmp(49) + trace_mudiv(t0131e, t0131o, eta_e, eta_o, t0031e, t0031o, mid, 1, 0, chemipt) !! Tr(   1 3 1 ) ! tmp
           ctmp(23) = ctmp(23) + trace_mudiv(t0221e, t0221o, eta_e, eta_o, t0121e, t0121o, mid, 0, 1, chemipt) !! Tr(   2 2 1 ) !
           ctmp(24) = ctmp(24) + trace_mudiv(t0321e, t0321o, eta_e, eta_o, t0121e, t0121o, mid, 0, 2, chemipt) !! Tr(   3 2 1 ) !
           ctmp(25) = ctmp(25) + trace_mudiv(t0231e, t0231o, eta_e, eta_o, t0131e, t0131o, mid, 0, 1, chemipt) !! Tr(   2 3 1 ) !
           ctmp(26) = ctmp(26) + trace_mudiv(t2211e, t2211o, eta_e, eta_o, t0211e, t0211o, mid, 1, 1, chemipt) !! Tr( 2 2 1 1 ) !
           ctmp(27) = ctmp(27) + trace_mudiv(t2121e, t2121o, eta_e, eta_o, t0121e, t0121o, mid, 1, 1, chemipt) !! Tr( 2 1 2 1 ) !
           ctmp(28) = ctmp(28) + trace_mudiv(t2221e, t2221o, eta_e, eta_o, t0221e, t0221o, mid, 1, 1, chemipt) !! Tr( 2 2 2 1 ) !
        !!endif

        call get_cg_stat(cg_stat, ncg, cgit, cgtot)
        call print_trace(" %PionNorm    ", traj, ctmp(1), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %pbp         ", traj, ctmp(2), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %p5p         ", traj, ctmp(3), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %pCp         ", traj, ctmp(4), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %pCinvMCp    ", traj, ctmp(5), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %pCinvMC2p   ", traj, ctmp(6), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %iMiM        ", traj, ctmp(7), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %iMiMiM      ", traj, ctmp(8), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %iMiMiMiM    ", traj, ctmp(9), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0002       ", traj, ctmp(10), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0003       ", traj, ctmp(11), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0022       ", traj, ctmp(12), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0032       ", traj, ctmp(13), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0033       ", traj, ctmp(14), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0222       ", traj, ctmp(15), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0322       ", traj, ctmp(16), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t2222       ", traj, ctmp(17), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0021       ", traj, ctmp(18), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0031       ", traj, ctmp(19), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0211       ", traj, ctmp(20), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0311       ", traj, ctmp(21), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t2111       ", traj, ctmp(22), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0221       ", traj, ctmp(23), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0321       ", traj, ctmp(24), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t0231       ", traj, ctmp(25), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t2211       ", traj, ctmp(26), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t2121       ", traj, ctmp(27), i*size_of_trace, ncg, cgit, cgtot)
        call print_trace(" %t2221       ", traj, ctmp(28), i*size_of_trace, ncg, cgit, cgtot)
     enddo

     call get_cg_stat(cg_stat, ncg, cgit, cgtot)
     call global_sum_vec(100, ctmp) ; ctmp = ctmp /dble(size_of_trace) / dble(nsrc)
     if (my_pe() == 0) then
        if (count == 1) then
             write(UREC, 400) "T", key_tr,  "traj", "mid", "Re(pbp)", "Im(pbp)", "Re(p5p)", "-Im(p5p)", "PionNorm", "etaNorm", "CGiter"
             write(UREC, 401) "T", key_trd, "traj", "mid", "Re(i2M)", "Im(i2M)", "Re(i3M)", "Im(i3M)", "Re(i4M)", "Im(i4M)"
             write(UREC, 401) "T", key_trc, "traj", "mid", "Re(pCp)", "Im(pCp)", "Re(pCincMCp)", "Im(pCinvMCp)", "Re(pCinvMC2p)", "Im(pCinvMC2p)"
             write(UREC, 401) "T", key_trm, "traj", "mid", "Re(invMdM)", "Im(invMdM)", "Re(invMd2M)", "Im(invMd2M)", "Re(invMdMinvMdM)", "Im(invMdMinvMdM)"
        endif
        write(UREC, 410) key_tr,  traj, mid, Re(ctmp(2)), Im(ctmp(2)), Re(ctmp(3)), -Im(ctmp(3)), Re(ctmp(1)), Im(ctmp(1)), cgit
        write(UREC, 411) key_trd, traj, mid, Re(ctmp(7)), Im(ctmp(7)), Re(ctmp(8)), Im(ctmp(8)), Re(ctmp(9)), Im(ctmp(9))
        write(UREC, 411) key_trc, traj, mid, Re(ctmp(4)), Im(ctmp(4)), Re(ctmp(5)), Im(ctmp(5)), Re(ctmp(6)), Im(ctmp(6))

        !!if (chemi /= 0 .or. chemi_i /=0) then
           do m= 1, 7
              write(UREC, 412) key_trm, m, traj, mid, Re(ctmp(7+m*3)), Im(ctmp(7+m*3)), Re(ctmp(8+m*3)), Im(ctmp(8+m*3)), Re(ctmp(9+m*3)), Im(ctmp(9+m*3))
           enddo
        !!endif
     endif
  enddo


400 format (1x, 2a,      a11, a6, 6a17,   a10)
410 format (1x, a5,      i11, i6, 6g17.7, i10)
401 format (1x, 2a,      a11, a6, 6a17   )
411 format (1x, a5,      i11, i6, 6g17.7 )
412 format (1x, a5, i2.2,i9,  i6, 6g17.7 )

end

!-------------------------------------------------------------------------------
subroutine print_trace(a, traj, in, n, ncall, iter, tot)
  use module_input
  use module_function_decl
  implicit none
  integer :: traj, n, ncall, iter, tot
  integer, save :: count=0
  COMPLEX :: in, tmp
  character(len=14) :: a

  if (count==0) then 
     if (traj > 1) then
        open(22,file = trim(input%measure_traces_file), action = "write", position = "append", &
                                                      status = "unknown")
     else
        open(22,file = trim(input%measure_traces_file), action = "write", status = "unknown")
     endif
     if (my_pe()==0)write(22,121)"T%trace       ", "traj", "Re()", "Im()", "CGcalls", "CGiters", "CGitTot"
  endif
  tmp=in
  call global_sum_vec(2,tmp); tmp=tmp !!!!/dble(n)
  if (my_pe()==0)write(22,122)a, traj, Re(tmp), Im(tmp), ncall, iter, tot
  count=1
  121 format (1x, a14,a6,2a20   , 3a10)
  122 format (1x, a14,i6,2g20.10, 3i10)
end

!-------------------------------------------------------------------------------
COMPLEX function trace_mudiv(oute, outo, eta_e, eta_o, zeta_e, zeta_o, mid, inv, idiv, chemipt)
  use module_vol
  use module_function_decl
  use module_p_interface
  implicit none
  SPINCOL_FIELD, intent(in)  :: eta_e, eta_o, zeta_e, zeta_o
  SPINCOL_FIELD, intent(out) :: oute, outo
  P_SPINCOL_FIELD, save :: tmpe, tmpo
  integer :: mid, inv, idiv
  COMPLEX :: chemipt

  ALLOCATE_SC_FIELD(tmpe)
  ALLOCATE_SC_FIELD(tmpo)

  if (idiv==0) then
     if (inv==1) then
        call solve(oute, outo, zeta_e, zeta_o, mid)
     else
        call die("trace_mudiv: idiv==0, inv==0")
     endif
  else
     if (inv==1) then
        call solve(tmpe, tmpo, zeta_e, zeta_o, mid)
        call apply_mp_chemu(oute, outo, tmpe, tmpo, mid, chemipt, idiv)
     else
        call apply_mp_chemu(oute, outo, zeta_e, zeta_o, mid, chemipt, idiv)
     endif
  endif
  trace_mudiv = sc_cdotc(eta_e, oute)  + sc_cdotc(eta_o, outo) !! Tr(...dM) or Tr(...dM)


end

!===============================================================================
subroutine breaking_mult(out, fac, in, volh)  ! out := fac B in
  use module_action
  implicit none
  COMPLEX, dimension (NDIRAC, *) :: out, in
  REAL                           :: fac
  integer                        :: volh
  integer :: i

  !$omp parallel do
  do i = 1, NCOL * volh
     out(1, i) = fac * ( breaking_term(1,1)*in(1,i) + breaking_term(1,2)*in(2, i) + breaking_term(1,3)*in(3,i) + breaking_term(1,4)*in(4,i) )
     out(2, i) = fac * ( breaking_term(2,1)*in(1,i) + breaking_term(2,2)*in(2, i) + breaking_term(2,3)*in(3,i) + breaking_term(2,4)*in(4,i) )
     out(3, i) = fac * ( breaking_term(3,1)*in(1,i) + breaking_term(3,2)*in(2, i) + breaking_term(3,3)*in(3,i) + breaking_term(3,4)*in(4,i) )
     out(4, i) = fac * ( breaking_term(4,1)*in(1,i) + breaking_term(4,2)*in(2, i) + breaking_term(4,3)*in(3,i) + breaking_term(4,4)*in(4,i) )
  enddo

end

!-------------------------------------------------------------------------------
