!===============================================================================
!
! cg_kernel_cg.F90 - cg kernel of BQCDi
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 1998-2016 Hinnerk Stueben
!               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/>.
!
!-------------------------------------------------------------------------------
# define LANGUAGE_FORTRAN
# include "defs.h"
# include "cg_defs.h"

!-------------------------------------------------------------------------------
# define TRACE_NAME T(cg_kernel_cg)
!-------------------------------------------------------------------------------
subroutine T(cg_kernel_cg)(x, b, id, iter, res) 

  ! solves "matrix_mult * x = b" and returns number of iterations

  use module_action
  use module_field
  use module_cg
  use module_cg_arrays
  use module_cg_procs, exclude => T(cg_kernel_cg)  ! avoid name clash
  use T(module_vol)
  use typedef_simd
  implicit none

  spincol_FIELD, intent(inout) :: x
  spincol_FIELD, intent(in)    :: b
  integer,       intent(in)    :: id
  integer,       intent(out)   :: iter
  DOUBLE,        intent(in)    :: res

  REAL          :: ak, bk
  DOUBLE        :: rtr, rtrold, paap, bb
  integer       :: i, niter, cid
  character(72) :: msg

!-------------------------------------------------------------------------------

  TRACE_ENTRY

  call cg_procs%norm2(bb, b, volh_tot, volh)

  TIMING_START(timing_bin_cg_global_sum)
  call global_sum_vec(1, bb)
  TIMING_STOP(timing_bin_cg_global_sum)

  call cg_procs%ww(cg_arrays%r, x, id)
  call cg_procs%loop1(rtrold, cg_arrays%r, cg_arrays%p, b, volh_tot, volh)

  TIMING_START(timing_bin_cg_global_sum)
  call global_sum_vec(1, rtrold)
  TIMING_STOP(timing_bin_cg_global_sum)

  niter = 1
  if (stop_condition(rtrold, res, bb)) goto 9999

  bk = ZERO
  do niter = 1, cg_para%maxiter
     call cg_procs%ww(cg_arrays%aap, cg_arrays%p, id)
     call cg_procs%loop2(paap, cg_arrays%p, cg_arrays%aap, volh_tot, volh)

     TIMING_START(timing_bin_cg_global_sum)
     call global_sum_vec(1, paap)
     TIMING_STOP(timing_bin_cg_global_sum)

     ak = rtrold / paap 

     call cg_procs%loop3(rtr, x, cg_arrays%r, cg_arrays%p, cg_arrays%aap, ak, volh_tot, volh)

     TIMING_START(timing_bin_cg_global_sum)
     call global_sum_vec(1, rtr)
     TIMING_STOP(timing_bin_cg_global_sum)

     if (stop_condition(rtr, res, bb)) goto 9999
     bk = rtr / rtrold
     rtrold = rtr

     call cg_procs%xpby(cg_arrays%p, cg_arrays%r, bk, volh_tot, volh)  ! p = r + bk * p
  enddo

  niter = niter - 1

  if (cg_para%log /= 2) then
     write(msg, *) "cg_kernel_cg(): no convergence; rtr = ", rtr 
     call die(msg)
  endif

9999 continue

  iter = niter

  TRACE_RETURN
end

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