!===============================================================================
!
! make_source.F90 - make sources
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007-2010 Yoshifumi Nakamura Hinnerk Stueben 
!
! 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 make_source(even, odd, sourcetype)
  use module_lattice
  use module_vol
  use module_function_decl
  implicit none
  SPINCOL_FIELD, intent(out) :: even, odd
  integer :: sourcetype

  if (sourcetype == FULL_SOURCE) then
     even=cmplx(ONE,ONE)
     odd =cmplx(ONE,ONE)
  elseif (sourcetype == RANDOM_SOURCE) then
     call ran_gauss_volh(NDIRAC * NCOL, even, HALF, EVEN)
     call ran_gauss_volh(NDIRAC * NCOL, odd,  HALF, ODD)
  elseif (sourcetype == LOCAL_SOURCE) then
!!     call make_source_local(even, odd, src_at)
  elseif (sourcetype == WALL_SOURCE) then
     if (my_pe()==0) call warn("wall source called S=1, C=1, T=0")
     call make_source_wall(1,1,0,even,odd)
  else
     call die("make_source: undefined sourcetype")
  endif

end

!-------------------------------------------------------------------------------
subroutine make_source_local(even, odd, src_at)
  use module_lattice
  use module_vol
  use module_function_decl
  implicit none
  integer :: coord(4), j(4)
  integer :: it,iz,iy,ix,ii
  integer, intent(in) :: src_at(4)
  SPINCOL_FIELD, intent(out) :: even, odd
  integer, external :: std_xyzt2i, e_o

  call pe2coord(my_pe(), coord)
  even = ZERO
  odd  = ZERO

  it = src_at(4) - nt*coord(4)
  iz = src_at(3) - nz*coord(3)
  iy = src_at(2) - ny*coord(2)
  ix = src_at(1) - nx*coord(1)

  if ( 0<=it .and. it < nt .and. &
       0<=iz .and. iz < nz .and. &
       0<=iy .and. iy < ny .and. &
       0<=ix .and. ix < nx) then

     j = (/ix, iy, iz, it/)
     ii = std_xyzt2i(j)
     if (e_o(j) == EVEN) then
        even(:,:,ii) = ONE
     else
         odd(:,:,ii) = ONE
     endif
  endif
end

!-------------------------------------------------------------------------------
subroutine make_quark_source(qeven,qodd, even, odd)
  use module_vol
  implicit none
  integer :: is, ic, i
  complex(8), dimension(4,4,3,3,volh), intent(out) :: qeven,qodd
  SPINCOL_FIELD, intent(in) :: even, odd

  qeven = 0
  qodd  = 0

  do i = 1, volh
  do ic = 1, 3
  do is = 1, 4
     qeven(is,is,ic,ic,i)= even(is,ic,i)
     qodd( is,is,ic,ic,i)=  odd(is,ic,i)
  enddo
  enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine get_quark_source(even, odd, qeven,qodd, is0, ic0)
  use module_vol
  implicit none
  integer :: is, ic, i
  integer, intent(in) :: is0, ic0
  complex(8), dimension(4,4,3,3,volh), intent(in) :: qeven,qodd
  SPINCOL_FIELD, intent(out) :: even, odd

  do i = 1, volh
  do ic = 1, 3
  do is = 1, 4
     even(is,ic,i) = qeven(is,is0,ic,ic0,i)
     odd( is,ic,i) = qodd( is,is0,ic,ic0,i)
  enddo
  enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine put_quark_source(qeven,qodd, even, odd, is0, ic0)
  use module_vol
  implicit none
  integer :: is, ic, i
  integer, intent(in) :: is0, ic0
  complex(8), dimension(4,4,3,3,volh), intent(out) :: qeven,qodd
  SPINCOL_FIELD, intent(in) :: even, odd

  do i = 1, volh
  do ic = 1, 3
  do is = 1, 4
     qeven(is,is0,ic,ic0,i) = even(is,ic,i)
     qodd( is,is0,ic,ic0,i) = odd( is,ic,i)
  enddo
  enddo
  enddo
end

!-------------------------------------------------------------------------------
subroutine make_source_wall(is, ic, src_t, even, odd)
  use module_lattice
  use module_vol
  use module_function_decl
  implicit none
  integer :: coord(4), j(4)
  integer :: it,iz,iy,ix,ii
  integer, intent(in) :: is,ic,src_t
  SPINCOL_FIELD, intent(out) :: even, odd
  integer, external :: std_xyzt2i, e_o


  call pe2coord(my_pe(), coord)

  even = ZERO
  odd  = ZERO

  it = src_t - nt*coord(4)
  if ( 0<=it .and. it < nt) then
     do iz=0,nz-1
     do iy=0,ny-1
     do ix=0,nx-1
        j = (/ix, iy, iz, it/)
        ii = std_xyzt2i(j)
        if (e_o(j) == EVEN) then
           even(is,ic,ii) = ONE
        else
            odd(is,ic,ii) = ONE
        endif
     enddo
     enddo
     enddo
  endif

end

!-------------------------------------------------------------------------------
subroutine make_source_0000(even, odd)                               !! for test

  use module_vol
  use module_function_decl
  implicit none

  SPINCOL_FIELD, intent(inout) :: even, odd

  even = ZERO
  odd  = ZERO

  if (my_pe()==0) then
     even(1,1,1) = ONE
!     ;even(1,2,1) = ONE;even(1,3,1) = ONE
!     even(2,1,1) = ONE;even(2,2,1) = ONE;even(2,3,1) = ONE
!     even(3,1,1) = ONE;even(3,2,1) = ONE;even(3,3,1) = ONE
!     even(4,1,1) = ONE;even(4,2,1) = ONE;even(4,3,1) = ONE
  endif

end

!===============================================================================
