!===============================================================================
!
! dds.F90 - subroutines to call DD solver (Andrea Nobile version)
!
!-------------------------------------------------------------------------------
!
! 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"

!-------------------------------------------------------------------------------
subroutine init_dds()
  use module_function_decl
  use module_nnpe
  use module_input
  use module_lattice
  use module_dd
  implicit none
  logical, save :: initialized = .false.

  integer, dimension(4) :: np       ! number of processes in each dimension
  integer, dimension(4) :: gl       ! global lattice size
  integer, dimension(4) :: cpr      ! coordinate of this process
  integer, dimension(4) :: cpr_bqcd
  integer, dimension(8) :: npr      ! nearest neigh
  integer, dimension(4) :: bs       ! block size 
  integer :: id                     ! mpi rank
  integer :: nmr, ncy, nkv, ndfl

  if (initialized) return

  np = (/ NPE(4), NPE(1), NPE(2), NPE(3) /)
  gl = (/ L(4), L(1), L(2), L(3) /)
  id = my_pe()
  call my_coord(cpr_bqcd)
  cpr = (/ cpr_bqcd(4), cpr_bqcd(1), cpr_bqcd(2), cpr_bqcd(3) /)

  npr(1) = nnpe( 0, 0, 0,-1)
  npr(2) = nnpe( 0, 0, 0, 1)
  npr(3) = nnpe(-1, 0, 0, 0)
  npr(4) = nnpe( 1, 0, 0, 0)
  npr(5) = nnpe( 0,-1, 0, 0)
  npr(6) = nnpe( 0, 1, 0, 0)
  npr(7) = nnpe( 0, 0,-1, 0)
  npr(8) = nnpe( 0, 0, 1, 0)

  bs = (/ddlat(4), ddlat(1), ddlat(2), ddlat(3)/)  !(/4, 4, 4, 4/)  

  !void dds_init_fc(int *np, int *gl, int *npr, int *cpr, int *id, int *bs)
  call dds_init_fc(np(1), gl(1), npr(1), cpr(1), id, bs(1))  

  !void dds_tune_fc(int *nmr, int *ncy, int *nkv, int *ndfl)
  nmr= input%tuning_dds_nmr
  ncy= input%tuning_dds_ncy
  nkv= input%tuning_dds_nkv
  ndfl=input%tuning_dds_ndfl
  call dds_tune_fc(nmr, ncy, nkv, ndfl)

  initialized = .true.
end

!-------------------------------------------------------------------------------
subroutine solve_invmtdagmt_dds(xe, be, mid, iter, res)
  use module_field
  use module_action
  use module_switches
  use module_vol
  use module_p_interface
  use module_function_decl
  use module_cg
  use module_lattice
  implicit none

  SPINCOL_FIELD, intent(out) :: xe
  SPINCOL_FIELD, intent(in)  :: be
  integer                    :: mid, calc_sf, iter, iter1, iter2
  REAL :: rtr,bb, res
  P_SPINCOL_FIELD, save      :: tmpe, tmpo, tmp1e, tmp1o
  real(8) :: kappa

  call init_dds()

  ALLOCATE_SC_FIELD(tmpe)
  ALLOCATE_SC_FIELD(tmpo)
  ALLOCATE_SC_FIELD(tmp1e)
  ALLOCATE_SC_FIELD(tmp1o)

  kappa=1.0/(2.0*action%mtilde(mid)%kappa)

  tmpe=be
  call gamma5(tmpe, volh)
  tmpo=0

! put the gauges & update clover
  call dds_fetch_gauge(mid, 0)

  call dds2(tmpe, tmpo, tmp1e, tmp1o, res, iter1)

  tmp1e=tmp1e*kappa
  
  call gamma5(tmp1e, volh)
  call clover_mult(tmpe, tmp1e, action%mtilde(mid)%cid ,EVEN)
  call clover_mult(tmp1e, tmpe, action%mtilde(mid)%cid ,EVEN)
  tmp1o=0

  call dds2(tmp1e, tmp1o, xe, tmpo, res, iter2)

  xe=xe*kappa

  iter= iter1 + iter2
  call wdagw(tmp1e, xe, mid)
  tmp1e=tmp1e-be
  rtr = sc_norm2(tmp1e); rtr= global_sum(rtr)
  bb  = sc_norm2(be)   ; bb = global_sum(bb)

  if (my_pe()==0)write(0,*)"solve_invmtdagmt_inner",sqrt(rtr/bb)

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

end

!-------------------------------------------------------------------------------
subroutine dds_fetch_gauge(mid, dd)
  use module_action
  use module_lattice
  integer, intent(in) :: mid, dd
  integer :: sw_update, gid
  REAL :: kappa,csw

  DEBUG2S("init_spu_solvers: started")

  kappa=action%mtilde(mid)%kappa
  csw=action%mtilde(mid)%cswkappa/kappa

  if (dd == 0) then
 !    call set_lat_parms_fc(beta,kappa,csw) 
     gid = 3
     call dd_put_gauge(gid)
     call dds_clover_fc(kappa, csw)
     gid = 2 
     call dd_put_gauge(gid)
     call dds_gauge_updated_fc()
  else
!     call init_multishift(kappa, csw)
!     call init_bqcd2ddmap
!     gid = 1 ; sw_update = 1         
!     call put_gauge_mshift(nx, ny, nz, nt, gid, sw_update)
!     gid = 2 ; sw_update = 0         
!     call put_gauge_mshift(nx, ny, nz, nt, gid, sw_update)
  endif

  DEBUG2S("init_spu_solvers: done")
end

!-------------------------------------------------------------------------------
subroutine ddg(uu,ix,iy,iz,it,mu,  up, gaugeid)
  use module_nn
  use module_field
  implicit none

  real(8) :: uu(2, 3, 3)

  integer :: up, eo, mu, ii, cc1, cc2, ix,iy,iz,it, j(4), gaugeid
  integer, external :: std_xyzt2i, e_o

  j = (/ix, iy, iz, it/)
  ii = std_xyzt2i(j)
  eo = e_o(j)

  if (up ==0 ) then
     ii=nn(ii,eo,mu,BWD)
     eo=1-eo
  endif

  do cc1=1,3
  do cc2=1,3
     uu(1,cc2,cc1)=dreal( gauge(gaugeid)%u(cc1,cc2,ii,  eo,mu))
     uu(2,cc2,cc1)=dimag( gauge(gaugeid)%u(cc1,cc2,ii,  eo,mu))
  enddo
  enddo

end

!-------------------------------------------------------------------------------
subroutine dds2(in_e, in_o, out_e, out_o, res, iter)
  use module_cg
  use module_vol
  use module_lattice
  implicit none
  SPINCOL_FIELD :: in_e, in_o, out_e, out_o
  integer:: i, it, ix, iy, iz, j(4), eo, iter
  integer :: nmx
  real(8) :: res, rtr
  integer, external :: std_xyzt2i, e_o, dds_solve_fc

!!  TIMING2_START(timing2_bin_dds)
  DEBUG2S("Start: dds")

  nmx = cg_para%maxiter

  do iz = 0, nz - 1
  do iy = 0, ny - 1
  do ix = 0, nx - 1
  do it = 0, nt - 1
     j = (/ix, iy, iz, it/)
     i = std_xyzt2i(j)
     eo = e_o(j)
     if ( eo == 0) then
        call dds_spinor_src_put_fc(it ,ix, iy, iz, in_e(1, 1, i))
     else
        call dds_spinor_src_put_fc(it ,ix, iy, iz, in_o(1, 1, i))
     endif
  enddo
  enddo
  enddo
  enddo

  DEBUG2S("Done sc reordering: at dds")


  DEBUG2S("Now  call dds_fc at dds")
  iter = dds_solve_fc(res, nmx, rtr)
  DEBUG2S("Done      dds_fc at dds")

  do iz = 0, nz - 1
  do iy = 0, ny - 1
  do ix = 0, nx - 1
  do it = 0, nt - 1
     j = (/ix, iy, iz, it/)
     i = std_xyzt2i(j)
     eo = e_o(j)
     if ( eo == 0) then
        call dds_spinor_dst_get_fc(it ,ix, iy, iz, out_e(1, 1, i))
     else
        call dds_spinor_dst_get_fc(it ,ix, iy, iz, out_o(1, 1, i))
     endif
  enddo
  enddo
  enddo
  enddo

  DEBUG2S("End: dds")
!!  TIMING2_STOP(timing2_bin_dds)

end

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