!===============================================================================
!
! solver_aggregate.F90
!
!-------------------------------------------------------------------------------
!
! 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 solve(out_e, out_o, in_e, in_o, mid)  ! solves:  D out = in
  use module_input
  use module_action
#ifdef BQCD_DDHMC
  use module_dd
#endif
  use module_vol
  use module_function_decl
  implicit none
  integer, intent(in) :: mid
  SPINCOL_FIELD, intent(out) :: out_e, out_o
  SPINCOL_FIELD, intent(in)  :: in_e, in_o
  REAL :: rtmp(2), time0, time1, kappa, res
  SECONDS  sekunden
  integer :: iter

  time0 = sekunden()

  if (input%fullsolver=="eo") then
     call solve_eo(out_e, out_o, in_e, in_o, mid)
  elseif (input%fullsolver=="dd") then
#ifdef BQCD_DDHMC
     if (ddable) then
        !!call test_mmul_mdag(mid)
        !!call dd_solve(mid, out_e, out_o, in_e, in_o)
        call dd_solve2(mid, out_e, out_o, in_e, in_o, CG_MC)
     else
        call die("solve(): not ddable")
     endif
#elif defined DDS
     kappa=1.0/(2.0*action%mtilde(mid)%kappa)
     call dds_fetch_gauge(mid, 0)
     call dds2(in_e, in_o, out_e, out_o, res, iter)
     out_e = out_e*kappa
     out_o = out_o*kappa
#else
     call die("solve(): no DD solver ")
#endif
  else
     call die("solve(): unknown solver: " // input%fullsolver)
  endif


  time1 = sekunden() - time0
  call check_solution(rtmp, out_e, out_o, in_e, in_o, mid)
  if (my_pe()==0)write(0,'(1x,"solve done: |b-Dx|/|b|=", g10.3, 2x, "Time=",g12.5)') &
                 sqrt(rtmp(2)/rtmp(1)), time1

end

!-------------------------------------------------------------------------------
subroutine solve_mtil(out, in, mid, tol)  ! solves: \tilde{D} out = in
  use module_input
  use module_vol
  use module_function_decl
  use module_cg
  implicit none
  integer, intent(in) :: mid, tol
  SPINCOL_FIELD, intent(out) :: out
  SPINCOL_FIELD, intent(in)  :: in
  SPINCOL_FIELD :: tmp
  integer iterations

  select case(input%mtilsolver)
     case("CGN")
        call mtil_dag(tmp, in, mid)
        call cg_outer(out, tmp, mid, 0, tol)
     case("BiCGstab")
        call bicgstab2(out, in, mid, iterations, cg_para%rest_mc ,12*volh_tot,12*volh)
     case default
        call die("solve_mtil: unknown solver: " // input%mtilsolver)
  end select
end

!-------------------------------------------------------------------------------
!
!   (Dee Deo) =  (1   Deo Dee^-1)*(\tilde{D}ee 0  )*(1            0)
!   (Doe Doo)    (0      1      ) (0           Doo) (Doo^-1 Doe   1)
!                 ~~~~~~~~~~~~~~                     ~~~~~~~~~~~~~~
!                       U                                  L
!   \tilde{D}ee = Dee - Deo Doo^-1 Doe 
!               or  1 - Dee^-1 Deo Doo^-1 Doe
!
!-------------------------------------------------------------------------------
subroutine solve_eo(out_e, out_o, in_e, in_o, mid)  ! solves:  D out = in
  use module_field
  use module_action
  use module_vol
  use module_p_interface
  use module_function_decl
  use module_cg
  implicit none

  integer, intent(in) :: mid
  SPINCOL_FIELD,  intent(out) :: out_e, out_o
  SPINCOL_FIELD,  intent(in)  :: in_e, in_o
  P_SPINCOL_FIELD, save :: tmp
  
  REAL     :: a, b
  COMPLEX  :: fac1, fac2
  integer  :: cid
  COMPLEX, parameter :: zone = cmplx(1,0)

  DEBUG2S("Start: solve_eo")
  ALLOCATE_SC_FIELD(tmp)

  a = ONE / (ONE + action%mtilde(mid)%h**2)
  b = action%mtilde(mid)%kappa / (ONE + action%mtilde(mid)%h**2)
  cid = action%mtilde(mid)%cid

!!
!! tmp =  in_e - Deo Doo^-1 in_o
!!
  if (chemi /= 0 .or. chemi_i /=0) then
     fac1=exp(cmplx( chemi, chemi_i))
     fac2=exp(cmplx(-chemi,-chemi_i))
     call emuu4(gauge(2)%u, fac1, fac2, .false.)
  endif
  if (action%mtilde(mid)%cswkappa /= ZERO) then
     call sc_copy(out_e, in_o)
     call clover_inv_mult(out_e, cid, so)
     call d(se, so, tmp, out_e, gauge(2)%u)
  elseif (action%mtilde(mid)%h /= ZERO) then
     call h_mult_c(out_e, -action%mtilde(mid)%h, in_o, volh)
     call d(se, so, tmp, out_e, gauge(2)%u)
  else
     call d(se, so, tmp, in_o, gauge(2)%u)
  endif
  call sc_xpby(tmp, in_e, b)
  if (chemi /= 0 .or. chemi_i /=0)call emuu4(gauge(2)%u, zone, zone, .false.)

!!
!! out_e = (\tilde{D})^{-1} tmp
!!
#ifdef OMTDTD
  if (action%mtilde(mid)%cswkappa /= ZERO) then
     call clover_inv_mult(tmp, cid, se)
  elseif (a /= ONE) then
     call h_mult_b( action%mtilde(mid)%h, tmp, volh)
  endif
#endif

  call solve_mtil(out_e, tmp, mid, CG_MC)

!!
!! out_o = Doo^{-1} ( in_o - Doe out_e )
!!
  if (chemi /= 0 .or. chemi_i /=0)call emuu4(gauge(2)%u, fac1, fac2, .false.)
  call d(so, se, out_o, out_e, gauge(2)%u)
  if (chemi /= 0 .or. chemi_i /=0)call emuu4(gauge(2)%u, zone, zone, .false.)
  call sc_axpby(out_o, in_o, b, a)!(inout, in, b, a)  ! inout = b * inout + a * in
  if (action%mtilde(mid)%cswkappa /= ZERO) then
     call clover_inv_mult(out_o, cid, so)
  elseif (action%mtilde(mid)%h /= ZERO) then
     call h_mult_b(-action%mtilde(mid)%h, out_o, volh)
  endif

  DEBUG2S("End: solve_eo")
end

!-------------------------------------------------------------------------------
subroutine check_solution(rout, zeta_e, zeta_o, eta_e, eta_o, mid)
  use module_vol
  use module_function_decl
  implicit none
  integer, intent(in) :: mid  
  SPINCOL_FIELD, intent(in) :: zeta_e, zeta_o, eta_e, eta_o
  SPINCOL_FIELD :: tmp1, tmp2
  REAL, intent(out) :: rout(2)

  call unprec_wmul(tmp1, tmp2, zeta_e, zeta_o, mid)
  call sc_sub(tmp1, eta_e)
  call sc_sub(tmp2, eta_o)
  rout(1) = sc_norm2(eta_e) + sc_norm2(eta_o)
  rout(2) = sc_norm2(tmp1)  + sc_norm2(tmp2)
  call global_sum_vec(2, rout)

end

!!!-------------------------------------------------------------------------------
!!subroutine solve_shifts(out_e, out_o, in_e, in_o, mid, n, shift)  ! solves:  (D + shift)out = in
!!  use module_input
!!  use module_action
!!  use module_vol
!!  use module_function_decl
!!  use module_cg
!!  implicit none
!!  integer, intent(in) :: mid, n
!!  complex(8), dimension (4, 3, volh_tot, n), intent(out) :: out_e, out_o
!!  complex(8), dimension (4, 3, volh_tot),    intent(in) :: in_e, in_o
!!  complex(8) :: shift(n)
!!  REAL :: rtmp(2), time0, time1, kappa, res, res_sh(n)
!!  SECONDS  sekunden
!!  integer :: iter, iter_sh(n)
!!  integer :: frdo(n)
!!
!!
!!  external :: wdagw_r8, mtil, unprec_wmul
!!
!!
!!  time0 = sekunden()
!!
!!  call get_cg_res(res, CG_MC)
!!  res_sh=res
!!
!!  frdo = 0
!!shift=100
!!shift(1) = dcmplx( 0.3_8, 0.3_8)
!!shift(2) = dcmplx( 0.3_8, 0.6_8)
!!shift(3) = dcmplx( 0.3_8, 0.9_8)
!!shift(4) = dcmplx( 0.6_8, 0.3_8)
!!shift(5) = dcmplx( 0.6_8, 0.6_8)
!!shift(6) = dcmplx( 0.6_8, 0.9_8)
!!shift(7) = dcmplx( 0.9_8, 0.3_8)
!!shift(8) = dcmplx( 0.9_8, 0.6_8)
!!shift(9) = dcmplx( 0.9_8, 0.9_8)
!!shift(11) = dcmplx( 0.3_8, -0.3_8)
!!shift(12) = dcmplx( 0.3_8, -0.6_8)
!!shift(13) = dcmplx( 0.3_8, -0.9_8)
!!shift(14) = dcmplx( 0.6_8, -0.3_8)
!!shift(15) = dcmplx( 0.6_8, -0.6_8)
!!shift(16) = dcmplx( 0.6_8, -0.9_8)
!!shift(17) = dcmplx( 0.9_8, -0.3_8)
!!shift(18) = dcmplx( 0.9_8, -0.6_8)
!!shift(19) = dcmplx( 0.9_8, -0.9_8)
!!shift(19) = dcmplx( 100.9_8, -10.9_8)
!!shift(21) = dcmplx( -0.3_8, 0.0_8)
!!shift(22) = dcmplx( -0.4_8, 0.0_8)
!!shift(23) = dcmplx( -0.5_8, 10.0_8)
!!shift(24) = dcmplx( -1.6_8, 0.0_8)
!!shift(25) = dcmplx( -0.06_8, 0.6_8)
!!shift(26) = dcmplx( -0.06_8, 0.9_8)
!!shift(27) = dcmplx( -0.09_8, 0.3_8)
!!shift(28) = dcmplx( -0.09_8, 0.6_8)
!!shift(29) = dcmplx( -0.09_8, 0.9_8)
!!shift(31) = dcmplx(- 0.03_8, -0.3_8)
!!shift(32) = dcmplx(- 0.03_8, -0.6_8)
!!shift(33) = dcmplx(- 0.03_8, -0.9_8)
!!shift(34) = dcmplx(- 0.06_8, -0.3_8)
!!shift(35) = dcmplx(- 0.06_8, -0.6_8)
!!shift(36) = dcmplx(- 10.06_8, -0.9_8)
!!shift(37) = dcmplx(- 0.09_8, -0.3_8)
!!shift(38) = dcmplx(- 0.09_8, -0.6_8)
!!shift(39) = dcmplx(- 100.09_8, -0.9_8)
!!
!!write(*,*)"call fom_zshift_full",  mid, n, frdo, shift,  iter, iter_sh, res_sh
!!  call fom_zshift_full(unprec_wmul, mid, n, frdo, shift, in_e, in_o, iter, iter_sh, res_sh)
!!
!!  time1 = sekunden() - time0
!!!  call check_solution(rtmp, out_e, out_o, in_e, in_o, mid)
!!!  if (my_pe()==0)write(0,'(1x,"solve done: |b-Dx|/|b|=", g10.3, 2x, "Time=",g12.5)') &
!!!                 sqrt(rtmp(2)/rtmp(1)), time1
!!
!!end
!!
!===============================================================================
