!===============================================================================
!
! module_cg.F90 - module for cg
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2007-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"

!-------------------------------------------------------------------------------
module module_cg

  character(len = 20), save :: outer_solver
  character(len = 20), save :: inner_solver
  integer, save :: criterion
  integer, save :: outer_steps
  integer, save :: mcmd      ! which "CG_MC" or "CG_MD" is at moment
  logical, save :: msap      ! Schwarz alternating procedure

  type type_cg_para
     REAL    :: rest_mc
     REAL    :: rest_md
     REAL    :: rest_domain_mc
     REAL    :: rest_domain_md
     REAL    :: rest_domain_sap
     REAL    :: rest_domain_def
     integer :: maxiter
     integer :: log
     integer :: check
  end type type_cg_para

  type(type_cg_para), save :: cg_para
  type(type_cg_para), save :: cg_ritz_para

  type type_cg_stat
     integer :: niter, niter4                    ! will be used for Fit
     integer :: ncall, niter_max, niter_tot      ! will be used in hmc
     integer :: niter_tot_run, niter_tot_run_sub ! will be used in timing
  end type type_cg_stat

  type(type_cg_stat), save ::       cg_stat
  type(type_cg_stat), save ::      cgm_stat
  type(type_cg_stat), save ::  cg_ritz_stat
  type(type_cg_stat), save :: bicgstab_stat
  type(type_cg_stat), save ::    gmres_stat
  type(type_cg_stat), save ::   gcrodr_stat


  type(type_cg_stat), save ::       dd_stat
  type(type_cg_stat), save ::       hh_stat


  integer, save :: cg_iterations_total = 0   ! used in timing.F90

!-------------------------------------------------------------------------------
contains
!-------------------------------------------------------------------------------
subroutine init_cg_para()
  use module_input
  implicit none

  read(input%solver_rest           , *) cg_para%rest_mc
  read(input%solver_rest_md        , *) cg_para%rest_md
  read(input%solver_rest_domain_mc , *) cg_para%rest_domain_mc
  read(input%solver_rest_domain_md , *) cg_para%rest_domain_md
  read(input%solver_rest_domain_sap, *) cg_para%rest_domain_sap
  read(input%solver_rest_domain_def, *) cg_para%rest_domain_def

  cg_para%maxiter   = input%solver_maxiter
  cg_para%log       = input%solver_ignore_no_convergence
  cg_para%check     = input%solver_check_solution


  read(input%solver_rest_cg_ritz   , *) cg_ritz_para%rest_mc
  cg_ritz_para%maxiter   = input%solver_maxiter
  cg_ritz_para%log       = input%solver_ignore_no_convergence
  cg_ritz_para%check     = input%solver_check_solution


  criterion = input%solver_stopping_criterion
  outer_solver    = input%solver_outer_solver
  inner_solver    = input%solver_inner_solver
  outer_steps = input%solver_outer_steps

  if (criterion < 0 .or. criterion >= 2)&
     call die("unknown stoppong criterion")

end subroutine init_cg_para

!-------------------------------------------------------------------------------
subroutine get_cg_res(res, cg_mcmd)
  implicit none
  integer, intent(in) :: cg_mcmd
  REAL, intent(out) :: res

  select case (cg_mcmd)
     case (CG_MC)
        res = cg_para%rest_mc
        mcmd= CG_MC
     case (CG_MD)
        res = cg_para%rest_md
        mcmd= CG_MD
     case (CG_HH)
        if (mcmd==CG_MC) res=cg_para%rest_domain_mc
        if (mcmd==CG_MD) res=cg_para%rest_domain_md
        if (msap)        res=cg_para%rest_domain_sap
     case default
        write(STDERR,*)"get_cg_res: unknown res", cg_mcmd
        call die("get_cg_res: unknown res")
  end select

end subroutine get_cg_res

!-------------------------------------------------------------------------------
subroutine init_cg_stat_all()
  implicit none

  call init_cg_stat(      cg_stat)
  call init_cg_stat(     cgm_stat)
  call init_cg_stat( cg_ritz_stat)
  call init_cg_stat(bicgstab_stat)
  call init_cg_stat(   gmres_stat)
  call init_cg_stat(  gcrodr_stat)
        cg_stat%niter_tot_run=0
       cgm_stat%niter_tot_run=0
   cg_ritz_stat%niter_tot_run=0
  bicgstab_stat%niter_tot_run=0
     gmres_stat%niter_tot_run=0
    gcrodr_stat%niter_tot_run=0
        cg_stat%niter_tot_run_sub=0
       cgm_stat%niter_tot_run_sub=0
   cg_ritz_stat%niter_tot_run_sub=0
  bicgstab_stat%niter_tot_run_sub=0
     gmres_stat%niter_tot_run_sub=0
    gcrodr_stat%niter_tot_run_sub=0

  call init_cg_stat(      dd_stat)
  call init_cg_stat(      hh_stat)
    dd_stat%niter_tot_run=0
    hh_stat%niter_tot_run=0
    dd_stat%niter_tot_run_sub=0
    hh_stat%niter_tot_run_sub=0

end subroutine init_cg_stat_all

!-------------------------------------------------------------------------------
subroutine init_cg_stat(stat)
  implicit none
  type(type_cg_stat) :: stat

  stat%ncall = 0
  stat%niter_max = 0
  stat%niter_tot = 0

end subroutine init_cg_stat

!-------------------------------------------------------------------------------
subroutine init_cg_stat2(stat)
  implicit none
  type(type_cg_stat) :: stat

  stat%niter = 0
  stat%niter4= 0

end subroutine init_cg_stat2

!-------------------------------------------------------------------------------
subroutine get_cg_stat(stat, ncall, niter_max, niter_tot)
  implicit none
  type(type_cg_stat) :: stat
  integer  ncall, niter_max, niter_tot

  ncall     = stat%ncall
  niter_max = stat%niter_max
  niter_tot = stat%niter_tot

end subroutine get_cg_stat

!-------------------------------------------------------------------------------
subroutine get_cg_stat2(stat, niter, niter4)
  implicit none
  type(type_cg_stat) :: stat
  integer  niter, niter4

  niter = stat%niter
  niter4= stat%niter4

end subroutine get_cg_stat2

!-------------------------------------------------------------------------------
subroutine update_cg_stat(stat, niter, niter_sub)
  implicit none
  type(type_cg_stat) :: stat
  integer  niter, niter_sub

  stat%ncall = stat%ncall + 1
  stat%niter = stat%niter + niter
  stat%niter4= stat%niter4+ niter_sub
  stat%niter_max = max(stat%niter_max, niter)
  stat%niter_tot = stat%niter_tot + niter
  stat%niter_tot_run = stat%niter_tot_run + niter
  stat%niter_tot_run_sub = stat%niter_tot_run_sub + niter_sub

end subroutine update_cg_stat

!-------------------------------------------------------------------------------
logical function stop_condition(rtr, res, b)
  implicit none
  REAL8,intent(in) :: rtr, res, b

  stop_condition = .false.

  if (criterion == 0) then
     stop_condition = (rtr <= res)
  else
     stop_condition = (sqrt(rtr) <= sqrt(b)*res )
  endif

end function stop_condition

!-------------------------------------------------------------------------------
REAL function res_cg_inner(res, rtr, b, n)
  implicit none
  REAL,intent(in) :: res, rtr, b
  integer, intent(in) :: n

     if (criterion == 0) then
        res_cg_inner = rtr*(res/rtr)**(dble(n)/dble(outer_steps))
     else
        res_cg_inner = (b*res**2/rtr)**(HALF/dble(outer_steps))
     endif

end function res_cg_inner

!-------------------------------------------------------------------------------
end module module_cg

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