!===============================================================================
!
! w_mult_block.F90  -  W := M~ + rho (Hasenbusch improvement)
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2008 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 interface_wdagw_block
!
!  interface
!     subroutine wdagw_block(out, in, id, extra_loops, r,  bk, paap)
!        use module_vol
!        implicit none
!        SPINCOL_OVERINDEXED         :: out, in, r
!        integer                     :: id
!        logical                     :: extra_loops
!        REAL                        :: bk
!        DOUBLE                      :: paap
!     end subroutine wdagw_block
!  end interface
!end

!-------------------------------------------------------------------------------
module interface_wmul_block
  interface
     subroutine wmul_block(out, in, id, extra_loops, p_or_r, bk, paap)
        use module_vol
        implicit none
        SPINCOL_OVERINDEXED, target :: out, in
        integer                     :: id
        logical                     :: extra_loops
        SPINCOL_OVERINDEXED         :: p_or_r
        REAL                        :: bk
        DOUBLE                      :: paap
     end subroutine wmul_block
  end interface
end

!-------------------------------------------------------------------------------
module interface_wdag_block
  interface
     subroutine wdag_block(out, in, id, extra_loops, p_or_r, bk, paap)
        use module_vol
        implicit none
        SPINCOL_OVERINDEXED, target :: out, in
        integer                     :: id
        logical                     :: extra_loops
        SPINCOL_OVERINDEXED         :: p_or_r
        REAL                        :: bk
        DOUBLE                      :: paap
     end subroutine wdag_block
  end interface
end

!-------------------------------------------------------------------------------
module module_m_mult_block

  REAL, dimension(:), pointer, save :: tmp1   ! sc2-field
  REAL, dimension(:), pointer, save :: tmp2   ! sc2-field
  integer, save :: n_block = 0


CONTAINS

  subroutine m_mult_block_set_n_block()
     use module_input
     use module_function_decl
     use module_vol
     implicit none

     if (n_block == 0) then
        n_block = volh / input%tuning_cg_block_length / num_threads()
        if (n_block * input%tuning_cg_block_length * num_threads() /=volh) &
        call die("m_mult_block: n_block * num_threads * block_length /=volh")
     endif
  end subroutine m_mult_block_set_n_block

  subroutine m_mult_block_get_i1i2(i1, i2, i_block)
     use module_input
     use module_function_decl
     use module_vol
     implicit none
     integer :: i1, i2, i_block

     i1 = (my_thread() * n_block + i_block) * input%tuning_cg_block_length + 1
     i2 = i1 + input%tuning_cg_block_length - 1
  end subroutine m_mult_block_get_i1i2

end

!-------------------------------------------------------------------------------
subroutine wdagw_block(out, in, id, extra_loops, r,  bk, paap)  ! out = (W+ W) in
  use module_vol
  use interface_wmul_block
  use interface_wdag_block
  implicit none
  SPINCOL_OVERINDEXED :: out, in, r, tmp
  integer,intent(in)  :: id
  logical,intent(in)  :: extra_loops
  REAL,   intent(in)  :: bk
  DOUBLE, intent(out) :: paap

  TIMING_START(timing_bin_mtdagmt)
  call wmul_block(tmp, in,  id, extra_loops, r,  bk, paap)
  call wdag_block(out, tmp, id, extra_loops, in, bk, paap)
  TIMING_STOP(timing_bin_mtdagmt)
end

!-------------------------------------------------------------------------------
subroutine wmul_block(out, in, id, extra_loops, p_or_r, bk, paap)

# undef DAGGER

# undef d
# define M_MULT_D d
# define PLUS +
# define MINUS -

#ifdef OMTDTD
# include "m_mult_omtdtd_block.h90"
#else
# include "m_mult_block.h90"
#endif

end
!-------------------------------------------------------------------------------
subroutine wdag_block(out, in, id, extra_loops, p_or_r, bk, paap)
# define DAGGER

# undef M_MULT_D
# undef PLUS
# undef MINUS

# undef d_dag
# define M_MULT_D d_dag
# define PLUS -
# define MINUS +

#ifdef clover_mult_block
# undef clover_mult_block
#endif
#ifdef clover_inv_mult_block
# undef clover_inv_mult_block
#endif
#ifdef clover_inv2_mult_block
# undef clover_inv2_mult_block
#endif

# define clover_mult_block      clover_dag_mult_block
# define clover_inv_mult_block  clover_dag_inv_mult_block
# define clover_inv2_mult_block clover_dag_inv2_mult_block

#ifdef OMTDTD
# include "m_mult_omtdtd_block.h90"
#else
# include "m_mult_block.h90"
#endif

end
!===============================================================================
