!===============================================================================
!
! cg_mbcg2.F90 - loops in cg_kernel_mbcg2
!
!-------------------------------------------------------------------------------
!
! 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
# include "defs.h"
# include "cg_defs.h"

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

  use 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 + Re(Spincol(p%%I, s1, s2, c, i)) * Re(Spincol(aap%%J, s1, s2, c, i))
     im_paap%%I%%J = im_paap%%I%%J + Re(Spincol(p%%I, s1, s2, c, i)) * Im(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 + Im(Spincol(p%%I, s1, s2, c, i)) * Im(Spincol(aap%%J, s1, s2, c, i))
     im_paap%%I%%J = im_paap%%I%%J - Im(Spincol(p%%I, s1, s2, c, i)) * Re(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 module_vol
  implicit none
  spincol_FIELD, intent(inout) :: p1, p2
  sc422_FLD, intent(in)        :: r1, r2
  REAL, intent(in)             :: r22
  COMPLEX, intent(in)          :: rho(2, 2)
  COMPLEX :: w1, w2
  integer :: i

  TRACE_ENTRY

  !$omp parallel do default(none) &
  !$omp shared(volh, r1, r2, p1, p2, r22, rho) &
  !$omp private(w1, w2)
  do i = 1, volh
  DO c = 1, 3
  DO s2 = 1, 2
  DO s1 = 1, 2
     w1 = r1(s1, s2, c, i)
     w2 = r2(s1, s2, c, i) * r22

     w1 = w1 + Spincol(p1, s1, s2, c, i) * conjg(rho(1, 1))
     w2 = w2 + Spincol(p1, s1, s2, c, i) * conjg(rho(2, 1))

     w1 = w1 + Spincol(p2, s1, s2, c, i) * conjg(rho(1, 2))
     w2 = w2 + Spincol(p2, s1, s2, c, i) * conjg(rho(2, 2))

     Spincol(p1, s1, s2, c, i) = w1
     Spincol(p2, s1, s2, c, i) = 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 module_vol
  implicit none
  sc422_FLD, intent(inout)  :: r1, r2
  spincol_FIELD, intent(in) :: aap1, aap2
  REAL, intent(in)          :: r22
  COMPLEX, intent(in)       :: alp(2, 2)
  REAL, intent(out)         :: sum(3)
  REAL :: r11
  COMPLEX :: r12
  integer :: i

  TRACE_ENTRY

  r11 = ZERO
  r12 = ZERO

  !$omp parallel do default(none) &
  !$omp shared(volh, r1, r2, aap1, aap2, r22, alp) &
  !$omp reduction(+:r11, r12)
  do i = 1, volh
  DO c = 1, 3
  DO s2 = 1, 2
  DO s1 = 1, 2
     r2(s1, s2, c, i) = r2(s1, s2, c, i) * r22

     r1(s1, s2, c, i) = r1(s1, s2, c, i) - Spincol(aap1, s1, s2, c, i) * alp(1, 1)
     r2(s1, s2, c, i) = r2(s1, s2, c, i) - Spincol(aap1, s1, s2, c, i) * alp(1, 2)

     r1(s1, s2, c, i) = r1(s1, s2, c, i) - Spincol(aap2, s1, s2, c, i) * alp(2, 1)
     r2(s1, s2, c, i) = r2(s1, s2, c, i) - Spincol(aap2, s1, s2, c, i) * alp(2, 2)
   
     r11 = r11 + Re(r1(s1, s2, c, i))**2 + Im(r1(s1, s2, c, i))**2
     r12 = r12 + conjg(r1(s1, s2, c, i)) * r2(s1, s2, c, i)

  ENDDO
  ENDDO
  ENDDO
  enddo

  sum(1) = r11
  sum(2) = Re(r12)
  sum(3) = Im(r12)

  TRACE_RETURN
end

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