!===============================================================================
!
! cg_kernel.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2012-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"

!-------------------------------------------------------------------------------
# define TRACE_NAME T(cg_kernel2)
!-------------------------------------------------------------------------------
subroutine T(cg_kernel2)(x, b, which_matrix, iterations, residual) 

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

  use      module_cg
  use      module_cg_arrays
  use      module_cg_procs, exclude => T(cg_kernel2)  ! avoid name clash
  use      module_counter
  use      module_function_decl
  use      T(module_vol)
  use      typedef_hmc
  use      typedef_simd
  implicit none

  spincol_FIELD,        intent(inout) :: x
  spincol_FIELD,        intent(in)    :: b
  integer,              intent(in)    :: which_matrix
  integer,              intent(out)   :: iterations
  REAL,                 intent(in)    :: residual

  REAL          :: ak, bk
  DOUBLE        :: n1, n2, n3, norm(3)
  DOUBLE        :: rtr, rtrold, paap
  DOUBLE        :: dtmp, dtmp1, dtmp2, dtmp3
  integer       :: i, niter
  character(72) :: msg
 
  TRACE_ENTRY
  TIMING_START(timing_bin_cg)

  call cg_procs%mm(cg_arrays%r, x, which_matrix)

  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)

  do niter = 1, cg_para%maxiter
     call cg_procs%mm(cg_arrays%aap, cg_arrays%p, which_matrix)

     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 (rtr <= residual) goto 9999

     bk = rtr / rtrold
     rtrold = rtr

     call cg_procs%xpby(cg_arrays%p, cg_arrays%r, bk, volh_tot, volh)
  enddo

  niter = niter - 1

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

9999 continue

  cg_stat%ncall = cg_stat%ncall + 1
  cg_stat%niter = niter
  cg_stat%niter_max = max(cg_stat%niter_max, niter)
  cg_stat%niter_tot = cg_stat%niter_tot + niter
  cg_iterations_total = cg_iterations_total + niter

  iterations = niter

  TIMING_STOP(timing_bin_cg)
  TRACE_RETURN
end

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