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

!-------------------------------------------------------------------------------
module quda
  logical, save :: initialized = .false.
end

!-------------------------------------------------------------------------------
subroutine bqcd_quda_init() 
  use module_lattice
  use module_action
  use module_cg
  use quda
  implicit none

  if (.not. initialized) then
     if ( bc_fermions(4)==1 ) call die("bqcd_quda does not work when bc_fermions(4)==1 ")
     call quda_init(nx, ny, nz, nt, cg_para%maxiter, action%mtilde(1)%cid, npe, bc_fermions(4))
     initialized = .true.
  endif

end

!-------------------------------------------------------------------------------
subroutine quda_cg(x, b, id, iter, res) 
  use module_switches
  use module_lattice
  use module_action
  use module_field
  use module_input
  use module_vol
  use module_cg
  use quda
  implicit none
  SPINCOL_OVERINDEXED,  intent(inout) :: x
  SPINCOL_OVERINDEXED,  intent(in)    :: b
  integer,              intent(out)   :: iter
  integer,              intent(in)    :: id
  DOUBLE,               intent(in)    :: res

  if (.not. switches%mass_kappa .and. action%mtilde(id)%rho/=ZERO) &
           call die("quda_cg does not work for  Mtilde = M + rho")

  if (chemi /= ZERO .or. chemi_i /=0) call die("quda_cg does not work with non zero chemi")

  if (action%mtilde(id)%cid/=0) then
     if (clvpar(action%mtilde(id)%cid)%lambda /= ZERO) &
        call die("quda_cg does not work with non zero lambda")
  endif

  !!call quda_test(id)

  TIMING_START(timing_bin_cg)

  call bqcd_quda_init()
  call quda_reset(id)
  call quda_inv(x, b, res, iter)

  call update_cg_stat(cg_stat, iter, 0)
  cg_iterations_total = cg_stat%niter_tot_run

  TIMING_STOP(timing_bin_cg)

end

!-------------------------------------------------------------------------------
subroutine quda_cgm(id, n, shift_switch, betabar, b, iterations, niter_shift, res) 
  use module_vol
  use module_field
  use module_cg
  implicit none
  SPINCOL_OVERINDEXED,           intent(in)  :: b
  integer,                       intent(out) :: iterations, niter_shift(n)
  integer,                       intent(in)  :: shift_switch(n), n, id
  REAL,                          intent(in)  :: betabar(n)
  REAL,                          intent(in)  :: res(n)
  REAL :: x(24*volh,n)
  external :: wdagw_r8
  integer :: iter, i, niter_sub

  !!call quda_test(id)

  DEBUG2S("Start: quda_cgm")

  TIMING_START(timing_bin_cg_mcg)
  call bqcd_quda_init()
  call quda_reset(id)
  call quda_minv(x, b, n, betabar, res, iter)
  DEBUG2I("       quda_cgm quda_minv",iter)

  do i = 1, n
     sco(1,i)%sco(1:24*volh)=x(1:24*volh,i)
  enddo

  iterations=iter
  niter_sub =iter*n
  call update_cg_stat(cgm_stat, iter, niter_sub)
  TIMING_STOP(timing_bin_cg_mcg)

  call multi_shift_cg(wdagw_r8, id, n, shift_switch, betabar, b, iterations, niter_shift, res)
  DEBUG2I("       quda_cgm multi_shift_cg", iterations)
  do i = 1, n
     call compare_sc(sco(1,i)%sco, x(1,i), 24*volh)
  enddo

  DEBUG2S("End: quda_cgm")

  call end_quda()
  call comm_finalize()
  call die("stop")

end

!-------------------------------------------------------------------------------
subroutine quda_test(mid)
  use module_lattice
  use module_action
  use module_field
  use module_vol
  use module_cg
  use module_function_decl
  use module_check_solution
  implicit none
  integer, intent(in) :: mid
  SPINCOL_OVERINDEXED :: zeta1, zeta2, eta_e, eta_o
  REAL :: res, time0, time1, res_list(14), norm_f(3), norm_q(3)
  integer :: maxiter, iter, iter_f, iter_q, i

  call stderr2("quda_test")

  call make_source(eta_e, eta_o, RANDOM_SOURCE)
  zeta1=ZERO ; zeta2=ZERO

  call get_cg_res(res, 0);  maxiter=7000
  call quda_init(nx, ny, nz, nt, maxiter, action%mtilde(mid)%cid, npe)
  call quda_reset(mid)

  call stderr2("Check d and quda_q")
  call d(so, se, zeta1, eta_e, gauge(2)%u)
  call quda_d(zeta2, eta_e, so)
  call compare_sc(zeta1, zeta2, 24*volh)


  if (action%mtilde(mid)%cid /=0) then
     call stderr2("Check clover mult")
     call clover_mult_a(zeta1, clover(action%mtilde(mid)%cid)%cfield%a(1,1,so), eta_e, volh)
     call quda_clover_mult(zeta2, eta_e, so)
     call compare_sc(zeta1, zeta2, 24*volh)

     call stderr2("Check cinvD")
     call d(so, se, zeta1, eta_e, gauge(2)%u)
     call clover_mult_ao(clover(action%mtilde(mid)%cid)%cfield%i(1,1,so), zeta1, volh)
     call quda_cinvd(zeta2, eta_e, so)
     call compare_sc(zeta1, zeta2, 24*volh)
  endif

  call stderr2("Check MtdagMt")
  call wdagw(zeta1, eta_e, mid)
  call quda_mdagm(zeta2, eta_e)
  call compare_sc(zeta1, zeta2, 24*volh)

  call stderr2("Check CG and QUDACG")
  zeta1=eta_e;  call cg(      zeta1, eta_e, mid, iter_f, res)
                call quda_inv(zeta2, eta_e, res, iter)
  call compare_sc(zeta1, zeta2, 24*volh)

  res_list( 1)=1d-1
  res_list( 2)=1d-2
  res_list( 3)=1d-3
  res_list( 4)=1d-4
  res_list( 5)=1d-5
  res_list( 6)=1d-6
  res_list( 7)=1d-7
  res_list( 8)=1d-8
  res_list( 9)=1d-9
  res_list(10)=1d-10
  res_list(11)=1d-11
  res_list(12)=1d-12
  res_list(13)=1d-13
  res_list(14)=1d-14


     zeta1 = eta_e
     zeta2 = eta_e
  do i = 1, 14
     zeta1 = eta_e
     zeta2 = eta_e
     call cg(zeta1, eta_e, mid, iter_f, res_list(i))
     !call quda_reset(mid)
     call quda_inv(zeta2, eta_e, res_list(i), iter_q)
     call check_solution(mid, zeta1, eta_e, norm_f)
     call check_solution(mid, zeta2, eta_e, norm_q)

     if (my_pe() == 0) then
        write(0, '(a, 4e15.5, i10)') "Fort", res_list(i), norm_f(1), sqrt(norm_f(1)/norm_f(2)), sqrt(norm_f(1)/norm_f(3)), iter_f
        write(0, '(a, 4e15.5, i10)') "QUDA", res_list(i), norm_q(1), sqrt(norm_q(1)/norm_q(2)), sqrt(norm_q(1)/norm_q(3)), iter_q
     endif
  enddo


  call end_quda()
  write(0,*)"quda_test: comm_finalize"
  call comm_finalize()
  call die("stop")
end

!-------------------------------------------------------------------------------
subroutine quda_reset(mid)
  use module_action
  use module_field
  use module_vol
  implicit none
  integer, intent(in) :: mid
  COMPLEX :: gf(3,3,volh,0:1,4) !!, clv(36,volh,0:1), clvinv(36,volh,0:1)
  integer :: i, mu, col1, col2, eo, cid

  call quda_setkappa(action%mtilde(mid)%kappa)

  call quda_gcopy(gauge(2)%u)

  !!do i = 1, volh
  !!   do mu = 1, DIM
  !!      do eo = 0, 1
  !!         do col2 = 1, NCOL
  !!         do col1 = 1, NCOL
  !!            gf(col2, col1, i, eo, mu) = gauge(2)%u(col1, col2, i, eo, mu)
  !!         enddo
  !!         enddo
  !!      enddo
  !!   enddo
  !!enddo
  !!call quda_gcopy(gf)
  !!call flip_bc(gauge(2)%u)

  cid = action%mtilde(mid)%cid
  if (cid /= 0) call quda_ccopy(clover(cid)%cfield%a, clover(cid)%cfield%i)

!!  if (action%mtilde(mid)%cid /= 0) then
!!     call quda_clov_pack(clv(1,1,se),       clover(action%mtilde(mid)%cid)%cfield%a(1,1,se))
!!     call quda_clov_pack(clv(1,1,so),       clover(action%mtilde(mid)%cid)%cfield%a(1,1,so))
!!     call quda_clovinv_pack(clvinv(1,1,se), clover(action%mtilde(mid)%cid)%cfield%i(1,1,se))
!!     call quda_clovinv_pack(clvinv(1,1,so), clover(action%mtilde(mid)%cid)%cfield%i(1,1,so))
!!     call quda_ccopy(clv, clvinv)
!!  endif

end

!-------------------------------------------------------------------------------
subroutine quda_clov_pack(pack_clov, a)
  use module_vol
  implicit none
  COMPLEX, dimension(18, 0:1, volh) :: a
  COMPLEX, dimension(18, 0:1, volh) :: pack_clov
  integer :: i, c

  !$omp parallel do private (c)
  do i = 1, volh
     do c = 0, 1
        pack_clov( 1,c,i)=  -a( 1,c,i)*2 +dcmplx(ONE,ONE)*2 !! i11 i22
        pack_clov( 2,c,i)=  -a(11,c,i)*2 +dcmplx(ONE,ONE)*2 !! i33 i44
        pack_clov( 3,c,i)=  -a(17,c,i)*2 +dcmplx(ONE,ONE)*2 !! i55 i66
        pack_clov( 4,c,i)= conjg(a(15,c,i)*2) !!  i54
        pack_clov( 5,c,i)= conjg(a(16,c,i)*2) !!  i64
        pack_clov( 6,c,i)=      -a( 4,c,i)*2  !! -i14
        pack_clov( 7,c,i)=      -a( 8,c,i)*2  !! -i24
        pack_clov( 8,c,i)=      -a(12,c,i)*2  !! -i34
        pack_clov( 9,c,i)= conjg(a(18,c,i)*2) !!  i65
        pack_clov(10,c,i)=      -a( 5,c,i)*2  !! -i15
        pack_clov(11,c,i)=      -a( 9,c,i)*2  !! -i25
        pack_clov(12,c,i)=      -a(13,c,i)*2  !! -i35
        pack_clov(13,c,i)=      -a( 6,c,i)*2  !! -i16
        pack_clov(14,c,i)=      -a(10,c,i)*2  !! -i26
        pack_clov(15,c,i)=      -a(14,c,i)*2  !! -i36
        pack_clov(16,c,i)= conjg(a( 2,c,i)*2) !!  i21
        pack_clov(17,c,i)= conjg(a( 3,c,i)*2) !!  i31
        pack_clov(18,c,i)= conjg(a( 7,c,i)*2) !!  i32
     enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine quda_clovinv_pack(pack, a)
  use module_vol
  implicit none
  COMPLEX, dimension(18, 0:1, volh) :: a
  COMPLEX, dimension(18, 0:1, volh) :: pack
  integer :: i, c

  !$omp parallel do private (c)
  do i = 1, volh
     do c = 0, 1
        pack( 1,c,i)= cmplx( aimag(a(11,c,i)), real(a(17,c,i)) )*2
        pack( 2,c,i)= cmplx( aimag(a(17,c,i)), real(a( 1,c,i)) )*2
        pack( 3,c,i)= cmplx( aimag(a( 1,c,i)), real(a(11,c,i)) )*2
        pack( 4,c,i)= conjg(a(15,c,i)*2) !!  i54
        pack( 5,c,i)= conjg(a(16,c,i)*2) !!  i64
        pack( 6,c,i)=      -a( 4,c,i)*2  !! -i14
	pack( 7,c,i)=      -a( 8,c,i)*2  !! -i24
        pack( 8,c,i)=      -a(12,c,i)*2  !! -i34
        pack( 9,c,i)= conjg(a(18,c,i)*2) !!  i65
        pack(10,c,i)=      -a( 5,c,i)*2  !! -i15
        pack(11,c,i)=      -a( 9,c,i)*2  !! -i25
        pack(12,c,i)=      -a(13,c,i)*2  !! -i35
        pack(13,c,i)=      -a( 6,c,i)*2  !! -i16
        pack(14,c,i)=      -a(10,c,i)*2  !! -i26
        pack(15,c,i)=      -a(14,c,i)*2  !! -i36
        pack(16,c,i)= conjg(a( 2,c,i)*2) !!  i21
        pack(17,c,i)= conjg(a( 3,c,i)*2) !!  i31
        pack(18,c,i)= conjg(a( 7,c,i)*2) !!  i32
     enddo
  enddo

end
