!===============================================================================
!
!  dd_solver_mpi.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2009-2010 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"

!-------------------------------------------------------------------------------
!
!   (Tee Meo) =  (1   Meo Tee^-1)*(\tilde{M}ee 0  )*(1            0)
!   (Moe Too)    (0      1      ) (0           Too) (Too^-1 Moe   1)
!                 ~~~~~~~~~~~~~~                     ~~~~~~~~~~~~~~
!                       U                                  L
!   \tilde{M}ee = Tee - Meo Too^-1 Moe
!
!-------------------------------------------------------------------------------
subroutine dd_solver(mid, out, in)  ! solves:  M out = in
  use module_vol
  use module_p_interface
  use module_function_decl
  implicit none
  integer, intent(in) :: mid
  SPINCOL_FIELD,  intent(out) :: out
  SPINCOL_FIELD,  intent(in)  :: in
  P_SPINCOL_FIELD, save :: tmp, xi, psi, tmp2,ttt
  integer  :: iter, mu, col, i
  COMPLEX :: res
  REAL :: dres
  external :: wmul, wmul_dd, wmul_eo
  external :: wdag, wdag_dd, wdag_eo
  external :: wdagw, wdagw_dd!!, wdagw_eo

  ALLOCATE_SC_FIELD(tmp)
  ALLOCATE_SC_FIELD(tmp2)
  ALLOCATE_SC_FIELD(psi)
  ALLOCATE_SC_FIELD(xi)
  ALLOCATE_SC_FIELD(ttt)


write(0,*)"=========================wmul"
  call check_wmul_wdag_eo(in, mid, wmul, wmul_dd, wmul_eo)
write(0,*)"=========================wdag"
  call check_wmul_wdag_eo(in, mid, wdag, wdag_dd, wdag_eo)
!!  call check_wmul_wdag_eo(in, mid, wdagw, wdagw_dd, wdagw_eo)
write(0,*)"=========================inv_wdagw_dd"
  call check_inv_wdagw_dd(in, mid)
!!stop

write(0,*)"=========================is wdagw hermit?"
  call wdagw(ttt, in, mid)    ;write(0,*)sc_cdotc(ttt,in)

write(0,*)"=========================is wdagw_dd hermit?"
  call wdagw_dd(ttt, in, mid) ;write(0,*)sc_cdotc(ttt,in)

write(0,*)"=========================is wdagw_eo hermit?"
  call wmul_eo(tmp, in, mid, 0)
  call wdag_eo(ttt, tmp,mid, 1);write(0,*)sc_cdotc(ttt,in)
stop


  call hatdaghat(ttt, in, mid, 0)    ;write(0,*)sc_cdotc(ttt,in)
  call hatdaghat(ttt, in, mid, 1)    ;write(0,*)sc_cdotc(ttt,in)
!!stop


!! inv(wmul_dd)
  call wdag_dd(tmp, in , mid)
  psi = tmp
  call cg_dd(psi, tmp, mid, iter, 1d-24, 2)
  call xm_invww_y(tmp, psi, psi, mid, 1)

!!
!! inv(H)
  call wdagw_hat_dag(tmp2,tmp,mid,0) ;  xi =tmp2
  call cg_hh(xi, tmp2, mid, iter, 1d-24, 0)

!!  call wdagw_hat(ttt, xi, mid, 0)
!!write(0,*)"after wdagw_hat",ttt(1,1,1),tmp(1,1,1)
!!stop

  call xm_invww_y(out, xi,  psi, mid, 0)
!!write(0,*)"final xm_invww_y", out(1,1,1),xi(1,1,1)

end

!-------------------------------------------------------------------------------
subroutine check_wmul_wdag_eo(in, id, mul, muldd, muleo)
  use module_vol
  use module_p_interface
  use module_function_decl
  implicit none
  integer, intent(in) :: id
  SPINCOL_FIELD,  intent(in)  :: in
  P_SPINCOL_FIELD, save :: psi, tmp, tmp2, ttt
  external :: mul, muldd, muleo
  logical, external :: check_sc

  ALLOCATE_SC_FIELD(ttt)
  ALLOCATE_SC_FIELD(tmp)
  ALLOCATE_SC_FIELD(tmp2)
  ALLOCATE_SC_FIELD(psi)

  call mul(psi, in, id)
  call muldd(ttt, in, id)
  call muleo(tmp, in, id, 0)
  call muleo(tmp2,in, id, 1)
  if (mod(my_pe(),2)==0) then
     ttt=ttt+tmp2
  else
     ttt=ttt+tmp
  endif

  if (.not. check_sc(ttt,psi) ) call die("check : dd eo for wmul or wdag")
end

!-------------------------------------------------------------------------------
subroutine check_inv_wdagw_dd(in, id)
  use module_vol
  use module_p_interface
  implicit none
  integer, intent(in) :: id
  SPINCOL_FIELD,  intent(in)  :: in
  P_SPINCOL_FIELD, save :: psi, ttt
  integer :: iter
  logical, external :: check_sc
  REAL :: res

  ALLOCATE_SC_FIELD(ttt)
  ALLOCATE_SC_FIELD(psi)

  res = 1d-14

!! inv(W^dagger W) W^dagger W = 1
!!
  call wdagw_dd(psi, in, id)
  ttt = psi
  call cg_dd(ttt, psi, id, iter, res, 2)
  if (.not. check_sc(ttt,in)) call die("check : inv_wdagw_dd 0")

!! W^dagger W inv(W^dagger W) = 1
!!
  ttt = in
  call cg_dd(ttt, in, id, iter, res, 2)
  call wdagw_dd(psi, ttt, id)
  if (.not. check_sc(psi,in)) call die("check : inv_wdagw_dd 1")

!! W inv(W^dagger W) W^dagger = 1
!!
  call wdag_dd(psi, in, id)
  ttt = psi
  call cg_dd(ttt, psi, id, iter, res, 2)
  call wmul_dd(psi, ttt, id)
  if (.not. check_sc(psi,in)) call die("check : inv_wdagw_dd 2")


  call wdagw_dd_eo(psi, in, id, 0); ttt = psi
  call cg_dd(ttt, psi, id, iter, res, 0)
  if (.not. check_sc(ttt,in)) call die("check : inv_wdagw_dd 00")
  ttt = in
  call cg_dd(ttt, in, id, iter, res, 0)
  call wdagw_dd_eo(psi, ttt, id, 0)
  if (.not. check_sc(psi,in)) call die("check : inv_wdagw_dd 01")
  call wdag_dd_eo(psi, in, id, 0) ;  ttt = psi
  call cg_dd(ttt, psi, id, iter, res, 0)
  call wmul_dd_eo(psi, ttt, id,0)
  if (.not. check_sc(psi,in)) call die("check : inv_wdagw_dd 02")

  call wdagw_dd_eo(psi, in, id, 1); ttt = psi
  call cg_dd(ttt, psi, id, iter, res, 1)
  if (.not. check_sc(ttt,in)) call die("check : inv_wdagw_dd 10")
  ttt = in
  call cg_dd(ttt, in, id, iter, res, 1)
  call wdagw_dd_eo(psi, ttt, id, 1)
  if (.not. check_sc(psi,in)) call die("check : inv_wdagw_dd 11")
  call wdag_dd_eo(psi, in, id, 1) ;  ttt = psi
  call cg_dd(ttt, psi, id, iter, res, 1)
  call wmul_dd_eo(psi, ttt, id,1)
  if (.not. check_sc(psi,in)) call die("check : inv_wdagw_dd 12")

end

!-------------------------------------------------------------------------------
logical function check_sc(in1, in2)
  use module_vol
  implicit none
  SPINCOL_FIELD,  intent(in)  :: in1, in2
  integer  :: mu, col, i, count
  COMPLEX :: res
  REAL :: dres

  count = 0
  do i = 1, volh
     do mu = 1, DIM
        dres = ZERO
        do col = 1,NCOL
           res= in1(mu,col,i) - in2(mu,col,i)
           dres = dres + res * conjg(res)
        enddo
        if (dres > 1d-24) then
           write(0,*)mu,i,dres
           count = count + 1
        endif
     enddo
  enddo

  check_sc = (count == 0) 
end
!===============================================================================
