!===============================================================================
!
! cg_mbcg2_simd.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2016 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/>.
!
!-------------------------------------------------------------------------------
# define LANGUAGE_FORTRAN
# define SIMD
# include "defs.h"
# include "cg_defs.h"
# include "simd.h"

!-------------------------------------------------------------------------------
# undef TRACE_NAME
# define TRACE_NAME T(cg_mbcg2_paap)
!-------------------------------------------------------------------------------
subroutine T(cg_mbcg2_paap)(paap, p1, p2, aap1, aap2)

  use typedef_simd
  use T(module_vol)
  implicit none
  integer, parameter :: re = 0
  integer, parameter :: im = 1

  REAL, intent(out)          :: paap(re:im, 2, 2)
  spincol_FIELD, intent(in)  :: p1, p2, aap1, aap2

  integer :: i
  REAL :: re_paap11, re_paap12, re_paap21, re_paap22  
  REAL :: im_paap11, im_paap12, im_paap21, im_paap22  

  TRACE_ENTRY

  DO J = 1, 2
  DO I = 1, 2
  FOR ri in re im
  ri%%_paap%%I%%J = ZERO
  ENDFOR     
  ENDDO     
  ENDDO     

  !$omp parallel do default(none) &
  !$omp shared(volh, p1, p2, aap1, aap2) &
  !$omp reduction(+: re_paap11, re_paap12, re_paap21, re_paap22) &
  !$omp reduction(+: im_paap11, im_paap12, im_paap21, im_paap22)
  do i = 1, volh
     DO c = 1, 3
     DO s2 = 1, 2
     DO s1 = 1, 2
     DO J = 1, 2
     DO I = 1, 2
     re_paap%%I%%J = re_paap%%I%%J + dot_product(Real(Spincol(p%%I, s1, s2, c, i)), Real(Spincol(aap%%J, s1, s2, c, i)))
     im_paap%%I%%J = im_paap%%I%%J + dot_product(Real(Spincol(p%%I, s1, s2, c, i)), Imag(Spincol(aap%%J, s1, s2, c, i)))

     ENDDO
     ENDDO
     DO J = 1, 2
     DO I = 1, 2
     re_paap%%I%%J = re_paap%%I%%J + dot_product(Imag(Spincol(p%%I, s1, s2, c, i)), Imag(Spincol(aap%%J, s1, s2, c, i)))
     im_paap%%I%%J = im_paap%%I%%J - dot_product(Imag(Spincol(p%%I, s1, s2, c, i)), Real(Spincol(aap%%J, s1, s2, c, i)))

     ENDDO
     ENDDO
     ENDDO
     ENDDO
     ENDDO
  enddo

  DO J = 1, 2
  DO I = 1, 2
  FOR ri in re im
  paap(ri, I, J) = ri%%_paap%%I%%J
  ENDFOR     
  ENDDO     
  ENDDO     

  TRACE_RETURN
end

!-------------------------------------------------------------------------------
# undef TRACE_NAME
# define TRACE_NAME T(cg_mbcg2_update_p)
!-------------------------------------------------------------------------------
subroutine T(cg_mbcg2_update_p)(p1, p2, r1, r2, r22, rho)

  use typedef_simd
  use T(module_vol)
  implicit none
  spincol_FIELD, intent(inout) :: p1, p2
  COMPLEX, intent(in)          :: r1(NDIRAC2, NDIRAC2, NCOL, *)
  COMPLEX, intent(in)          :: r2(NDIRAC2, NDIRAC2, NCOL, *)
  REAL, intent(in)             :: r22
  COMPLEX, intent(in)          :: rho(2, 2)
  SIMD_COMPLEX :: w1, w2
  integer :: i, j, c, s1, s2, w

  TRACE_ENTRY

  !$omp parallel do default(none) &
  !$omp shared(volh, r1, r2, p1, p2, r22, rho) &
  !$omp private(i, c, s1, s2, w, w1, w2)
  do j = 0, volh - 1
     i = j * SIMD_WIDTH
     do c = 1, 3
     do s2 = 1, 2
     do s1 = 1, 2
        do w = 1, SIMD_WIDTH
           w1%r(w) = Re(r1(s1, s2, c, i+w))
           w1%i(w) = Im(r1(s1, s2, c, i+w))
           w2%r(w) = Re(r2(s1, s2, c, i+w)) * r22
           w2%i(w) = Im(r2(s1, s2, c, i+w)) * r22
        enddo

        DO J = 1, 2
        DO I = 1, 2
        Real(w%%I) = Real(w%%I) + Real(Spincol(p%%J, s1, s2, c, j+1)) * Re(rho(I, J))
        Imag(w%%I) = Imag(w%%I) - Real(Spincol(p%%J, s1, s2, c, j+1)) * Im(rho(I, J))

        ENDDO
        ENDDO

        DO J = 1, 2
        DO I = 1, 2
        Real(w%%I) = Real(w%%I) + Imag(Spincol(p%%J, s1, s2, c, j+1)) * Im(rho(I, J))
        Imag(w%%I) = Imag(w%%I) + Imag(Spincol(p%%J, s1, s2, c, j+1)) * Re(rho(I, J))

        ENDDO
        ENDDO

        Real(Spincol(p1, s1, s2, c, j+1)) = Real(w1)
        Imag(Spincol(p1, s1, s2, c, j+1)) = Imag(w1)
        Real(Spincol(p2, s1, s2, c, j+1)) = Real(w2)
        Imag(Spincol(p2, s1, s2, c, j+1)) = Imag(w2)
     enddo
     enddo
     enddo
  enddo

  TRACE_RETURN
end

!-------------------------------------------------------------------------------
# undef TRACE_NAME
# define TRACE_NAME T(cg_mbcg2_update_r)
!-------------------------------------------------------------------------------
subroutine T(cg_mbcg2_update_r)(r1, r2, aap1, aap2, r22, alp, sum)

  use typedef_simd
  use T(module_vol)
  implicit none
  COMPLEX, intent(inout)    :: r1(NDIRAC2, NDIRAC2, NCOL, *)
  COMPLEX, intent(inout)    :: r2(NDIRAC2, NDIRAC2, NCOL, *)
  spincol_FIELD, intent(in) :: aap1, aap2
  REAL, intent(in)          :: r22
  COMPLEX, intent(in)       :: alp(2, 2)
  REAL, intent(out)         :: sum(3)
  REAL :: r11, re_r12, im_r12
  SIMD_COMPLEX :: w1, w2
  integer :: i, j, c, s1, s2, w

  TRACE_ENTRY

  r11 = ZERO
  re_r12 = ZERO
  im_r12 = ZERO

  !$omp parallel do default(none) &
  !$omp shared(volh, r1, r2, aap1, aap2, r22, alp) &
  !$omp private(i, c, s1, s2, w, w1, w2) &
  !$omp reduction(+:r11, re_r12, im_r12)
  do j = 0, volh - 1
     i = j * SIMD_WIDTH
     do c = 1, 3
     do s2 = 1, 2
     do s1 = 1, 2
        do w = 1, SIMD_WIDTH
           r2(s1, s2, c, i+w) = r2(s1, s2, c, i+w) * r22
           w1%r(w) = Re(r1(s1, s2, c, i+w))
           w1%i(w) = Im(r1(s1, s2, c, i+w))
           w2%r(w) = Re(r2(s1, s2, c, i+w))
           w2%i(w) = Im(r2(s1, s2, c, i+w))
        enddo

        DO J = 1, 2
        DO I = 1, 2
        Real(w%%I) = Real(w%%I) - Real(Spincol(aap%%J, s1, s2, c, j+1)) * Re(alp(J, I))
        Imag(w%%I) = Imag(w%%I) - Real(Spincol(aap%%J, s1, s2, c, j+1)) * Im(alp(J, I))

        ENDDO
        ENDDO

        DO J = 1, 2
        DO I = 1, 2
        Real(w%%I) = Real(w%%I) + Imag(Spincol(aap%%J, s1, s2, c, j+1)) * Im(alp(J, I))
        Imag(w%%I) = Imag(w%%I) - Imag(Spincol(aap%%J, s1, s2, c, j+1)) * Re(alp(J, I))

        ENDDO
        ENDDO

        do w = 1, SIMD_WIDTH
           r1(s1, s2, c, i+w) = cmplx(w1%r(w), w1%i(w), RKIND)
           r2(s1, s2, c, i+w) = cmplx(w2%r(w), w2%i(w), RKIND)
           r11 = r11 + w1%r(w)**2 + w1%i(w)**2
           re_r12 = re_r12 + w1%r(w) * w2%r(w) + w1%i(w) * w2%i(w) 
           im_r12 = im_r12 + w1%r(w) * w2%i(w) - w1%i(w) * w2%r(w) 
        enddo

     enddo
     enddo
     enddo
  enddo

  sum(1) = r11
  sum(2) = re_r12
  sum(3) = im_r12 

  TRACE_RETURN
end

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