!===============================================================================
!
! ddsc.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2009-2010 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 ddsc_copy(out, in) ! out = in
  use module_dd
  implicit none
  COMPLEX, dimension (12*ld%lat%volh) :: out, in
  integer :: i

  !$omp parallel do
  do i = 1, 12*ld%lat%volh
     out(i) = in(i)
  enddo
end
!-------------------------------------------------------------------------------
subroutine ddsc_add(out, in) ! out = out + in
  use module_dd
  implicit none
  COMPLEX, dimension (12*ld%lat%volh),intent(inout) :: out
  COMPLEX, dimension (12*ld%lat%volh),intent(in) :: in
  integer :: i

  !$omp parallel do
  do i = 1, 12*ld%lat%volh
     out(i) = out(i) + in(i)
  enddo
end
!-------------------------------------------------------------------------------
subroutine ddsc_sub(out, in) ! out = out - in
  use module_dd
  implicit none
  COMPLEX, dimension (12*ld%lat%volh),intent(inout) :: out
  COMPLEX, dimension (12*ld%lat%volh),intent(in) :: in
  integer :: i

  !$omp parallel do
  do i = 1, 12*ld%lat%volh
     out(i) = out(i) - in(i)
  enddo
end
!-------------------------------------------------------------------------------
subroutine ddsc_sub2(out, in) ! out = in - out
  use module_dd
  implicit none
  COMPLEX, dimension (12*ld%lat%volh),intent(inout) :: out
  COMPLEX, dimension (12*ld%lat%volh),intent(in) :: in
  integer :: i

  !$omp parallel do
  do i = 1, 12*ld%lat%volh
     out(i) = in(i) - out(i)
  enddo
end

!-------------------------------------------------------------------------------
subroutine ddsc_axpy(out, in, a) ! out = out + a * in
  use module_dd
  implicit none
  REAL, dimension (24*ld%lat%volh) :: out, in
  REAL :: a
  integer :: i

  !$omp parallel do
  do i = 1, 24*ld%lat%volh
     out(i) = out(i) + a * in(i)
  enddo
end

!-------------------------------------------------------------------------------
subroutine ddsc_xpby(out, in, b) ! out = in + b * out
  use module_dd
  implicit none
  REAL, dimension (24*ld%lat%volh) :: out, in
  REAL :: b
  integer :: i

  !$omp parallel do
  do i = 1, 24*ld%lat%volh
     out(i) = in(i) + b * out(i)
  enddo
end

!-------------------------------------------------------------------------------
subroutine ddsc_axpby(inout, in, b, a) ! inout = b * inout + a * in 
  use module_dd
  implicit none
  REAL, dimension (24*ld%lat%volh) :: inout, in
  REAL :: a, b
  integer :: i

  !$omp parallel do
  do i = 1, 24*ld%lat%volh
     inout(i) = b * inout(i) + a * in(i)
  enddo
end

!-------------------------------------------------------------------------------
subroutine ddsc_caxpy(inout, in, a) ! inout = inout + a * in
  use module_dd
  implicit none
  COMPLEX, dimension (12*ld%lat%volh) :: inout, in
  COMPLEX :: a
  integer :: i

  !$omp parallel do
  do i = 1, 12*ld%lat%volh
     inout(i) = inout(i) + a * in(i)
  enddo

end

!-------------------------------------------------------------------------------
REAL function ddsc_norm2(in)
  use module_dd
  implicit none
  COMPLEX, dimension (12*ld%lat%volh) :: out, in
  integer :: i
  REAL :: tmp

  tmp = ZERO
  !$omp parallel do reduction(+: tmp)
  do i = 1, 12*ld%lat%volh
     tmp = tmp + in(i) * conjg(in(i))
  enddo

  ddsc_norm2 = tmp

end

!-------------------------------------------------------------------------------
COMPLEX function ddsc_cdotc(x, y)  ! Sum_i conjg(x_i) * y_i
  use module_dd
  implicit none
  COMPLEX, dimension (12*ld%lat%volh) :: x, y
  COMPLEX :: tmp
  integer :: i


  tmp = dcmplx(ZERO,ZERO)
  !$omp parallel do reduction(+: tmp)
  do i = 1, 12*ld%lat%volh
     tmp = tmp + y(i) * conjg(x(i))
  enddo

  ddsc_cdotc = tmp

end

!-------------------------------------------------------------------------------
subroutine ddsc_copy_eo(out, in, eo) ! out = in
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1) :: out, in
  integer,intent(in) :: eo
  integer :: ip

  if (.not.(eo==0 .or. eo==1))&
  call die("ddsc_copy_eo: wrong eo ")

  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo) then
        call ddsc_copy(out(1,ip,0), in(1,ip,0))
        call ddsc_copy(out(1,ip,1), in(1,ip,1))
     endif
  enddo

end

!-------------------------------------------------------------------------------
subroutine ddsc_add_eo(out, in, eo) ! out = out + in
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(inout) :: out
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(in) :: in
  integer,intent(in) :: eo
  integer :: ip

  if (.not.(eo==0 .or. eo==1))&
  call die("ddsc_add_eo: wrong eo ")

  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo) then
        call ddsc_add(out(1,ip,0), in(1,ip,0))
        call ddsc_add(out(1,ip,1), in(1,ip,1))
     endif
  enddo

end

!-------------------------------------------------------------------------------
subroutine ddsc_sub_eo(out, in, eo) ! out = out - in
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(inout) :: out
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(in) :: in
  integer,intent(in) :: eo
  integer :: ip

  if (.not.(eo==0 .or. eo==1))&
  call die("ddsc_sub_eo: wrong eo ")

  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo) then
        call ddsc_sub(out(1,ip,0), in(1,ip,0))
        call ddsc_sub(out(1,ip,1), in(1,ip,1))
     endif
  enddo

end

!-------------------------------------------------------------------------------
subroutine ddsc_sub2_eo(out, in, eo) ! out = in - out
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(inout) :: out
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1),intent(in) :: in
  integer,intent(in) :: eo
  integer :: ip

  if (.not.(eo==0 .or. eo==1))&
  call die("ddsc_sub2_eo: wrong eo ")

  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo) then
        call ddsc_sub2(out(1,ip,0), in(1,ip,0))
        call ddsc_sub2(out(1,ip,1), in(1,ip,1))
     endif
  enddo
end

!-------------------------------------------------------------------------------
subroutine ddsc_axpy_eo(out, in, a, eo) ! out = out + a * in
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1) :: out, in
  REAL :: a
  integer,intent(in) :: eo
  integer :: ip

  if (.not.(eo==0 .or. eo==1))&
  call die("ddsc_sub2_eo: wrong eo ")

  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo) then
        call ddsc_axpy(out(1,ip,0), in(1,ip,0),a)
        call ddsc_axpy(out(1,ip,1), in(1,ip,1),a)
     endif
  enddo
end

!-------------------------------------------------------------------------------
subroutine ddsc_xpby_eo(out, in, b, eo) ! out = in + b * out
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1) :: out, in
  REAL :: b
  integer,intent(in) :: eo
  integer :: ip

  if (.not.(eo==0 .or. eo==1))&
  call die("ddsc_sub2_eo: wrong eo ")

  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo) then
        call ddsc_xpby(out(1,ip,0), in(1,ip,0),b)
        call ddsc_xpby(out(1,ip,1), in(1,ip,1),b)
     endif
  enddo
end

!-------------------------------------------------------------------------------
REAL function ddsc_norm2_eo(in, eo)
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1) :: in
  integer,intent(in) :: eo
  integer :: ip
  REAL :: tmp
  REAL, external :: ddsc_norm2

  if (.not.(eo==0 .or. eo==1 .or. eo==2))&
  call die("ddsc_norm2_eo: wrong eo ")

  tmp = ZERO
  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo .or. eo==2) then
        tmp = tmp + ddsc_norm2(in(1,ip,0)) + ddsc_norm2(in(1,ip,1))
     endif
  enddo

  ddsc_norm2_eo = tmp
end

!-------------------------------------------------------------------------------
COMPLEX function ddsc_cdotc_eo(x,y, eo)
  use module_dd
  use module_function_decl
  implicit none
  COMPLEX, dimension (12*ld%lat%volh,0:ld%lat%num_ip-1,0:1) :: x,y
  integer,intent(in) :: eo
  integer :: ip
  COMPLEX :: tmp
  COMPLEX, external :: ddsc_cdotc

  if (.not.(eo==0 .or. eo==1 .or. eo==2))&
  call die("ddsc_cdotc_eo: wrong eo ")

  tmp = ZERO
  do ip = 0, ld%lat%num_ip-1
     if(eo_dm(ip) == eo .or. eo==2) then
        tmp = tmp + ddsc_cdotc(x(1,ip,0),y(1,ip,0)) &
                  + ddsc_cdotc(x(1,ip,1),y(1,ip,1))
     endif
  enddo

  ddsc_cdotc_eo = tmp
end

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