!===============================================================================
!
! cg_control.F90
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2008,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/>.
!
!-------------------------------------------------------------------------------
! Add a complex multi-shift solver, MCR and general matrix inversion methods
!
! Editor: Taylor Haar
! Last modified: 29/09/2016
!-------------------------------------------------------------------------------
# include "defs.h"

!-------------------------------------------------------------------------------
subroutine cg_outer(x, b, id, np, calc_sf)
  use module_input
  use module_cg
  use module_vol
  use module_function_decl
  use module_action
  implicit none

  integer,        intent(in)  :: calc_sf, id, np ! np = n-th pseudo fermion
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), intent(inout):: x
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), intent(in)   :: b
  REAL :: res, time0, time1
  integer :: iters, iters4
  SECONDS sekunden

  DEBUG2S("Start: cg_outer")
  time0=sekunden()
#ifdef FPCOLL
call start_collection("cg_outer")
#endif
  call get_cg_res(res, calc_sf)

  select case(outer_solver)
     case("cg")
        if (input%tuning_cg_loop_blocking /= 0) then
           call cg_block(     x, b, id, iters, res)
        else
           call cg(           x, b, id, iters, res)
        endif
#ifdef DDS
     case("dd"); call solve_invmtdagmt_dds(   x, b, id, iters, res)
#endif
     case("bicgstab");     call bicgstab(     x, b, id, iters, res)
     case("gmres");        call gmres(        x, b, id, iters, res)
     case("gcrodr")
        call init_gcrodr()
        call gcrodr(       x, b, id, iters, res)
     case("cg_mix")
        call cg_mix(       x, b, id, iters, iters4, res)
        call iteration_count_is_f4(iters4, np)
     case("bicgstab_mix")
        call bicgstab_mix( x, b, id, iters, iters4, res)
        call iteration_count_is_f4(iters4, np)
#ifdef QUDA
     case("qudacg")
        call quda_cg(      x, b, id, iters, res)
#endif
#ifdef MICVMULT
     case("vmcg")
        call vm_cg(      x, b, id, iters, res)
#endif
     case default
        call die("cg_outer: unknown solver: " // outer_solver )
  end select
  call iteration_count_is_f(iters, np)

  time1 = sekunden()-time0
  if(my_pe()==0 )write(0,'(1x,"CG done: np=",i2,1x,"kappa=",f12.7,1x,"iter=",i12,1x, "Time=", g12.5)') &
  np, action%mtilde(id)%kappa, iters, time1
#ifdef FPCOLL
call stop_collection("cg_outer")
#endif
  DEBUG2S("End: cg_outer")
end

#ifdef BQCD_DDHMC
!-------------------------------------------------------------------------------
integer function cg_dd_outer(matrix, x, b, id, ip, calc_sf)
  use module_input
  use module_cg
  use module_dd
  use module_dd_evec
  use module_function_decl
  use module_input
  implicit none
  integer, intent(in)  :: id, ip, calc_sf,matrix
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(inout):: x
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(in)   :: b
  integer :: iters, ii, m, mdm
  REAL :: res

  call get_cg_res(res, calc_sf)
  if (criterion==0)res=res/(ld%lat%num_ip*num_pes())
  call init_eig_dd(2)
  m = input%solver_numkrylov_mtdmtdd
  mdm = 1
  if (matrix==MTDAG_DD) mdm = 2

  if (calc_sf == CG_HH) then
     if (dd_evec) then
        call gcrodr_dd(matrix, x, b, id, ip, iters, res, m)
        !!if(evecdd(ip,mdm)%fresh) then
        !!   call gmrespj_dd(matrix, x, b, id, ip, iters, res, m)
        !!else
        !!   call gmresdr_dd(matrix, x, b, id, ip, iters, res, m)
        !!endif
     else
        if (matrix==MTDAGMT_DD) then
           call cg_dd(matrix,   x, b, id, ip, iters, res) ! faster
        else
           call gmres_dd(matrix,x, b, id, ip, iters, res, m)
        endif
     endif
  else
     select case(outer_solver)
     case("cg"); call cg_dd(matrix,        x, b, id, ip, iters, res)
     case("cg_mix"); call cg_dd_mix(matrix,x, b, id, ip, iters, res)
     case default;call die("cg_dd_outer: unknown solver: " // outer_solver)
     end select
  endif
  cg_dd_outer=iters

!! here some tests
!! call bicgstab_dd(matrix, x, b, id, ip, iters, res) !! bit slow
!! call eig_mtmul_dd(id)                              !! very slow
!!     if (msap) res=sqrt(res)
!!     call eig_mtdagmt_dd(id)             !! very slow
!!     if(dd_evec) then
!!        call test_cg_ritz_dd_loop(id) !! vert slow
!!        call cg_def(x, b, id, ip, iters, (cg_para%rest_domain_def*10)) !! very slow
!!     endif
!!
!!   To clean solution up
!!     call cg_dd(matrix,        x, b, id, ip, iters, res)
!!     if(dd_evec) then
!!       if(my_pe()==0)write(0,*)"cg_def: cleaning        ",iters
!!     endif

end

!-------------------------------------------------------------------------------
integer function cg_dd_outer_r4(matrix, x, b, id, ip, calc_sf)
  use module_input
  use module_cg
  use module_dd
  use module_function_decl
  implicit none

  integer, intent(in)  :: id, ip, calc_sf, matrix
  real(4), dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(inout):: x
  real(4), dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(in)   :: b
  REAL :: res
  integer :: iters, m

  call get_cg_res(res, calc_sf)
  if (criterion==0)res=res/(ld%lat%num_ip*num_pes())
  m = input%solver_numkrylov_mtdmtdd

  if (calc_sf == CG_HH .and. (matrix==MTMUL_DD .or. matrix==MTDAG_DD) ) then
     call gmres_dd_r4(matrix,    x, b, id, ip, iters, res, m)
!!     call bicgstab_dd_r4(matrix,    x, b, id, ip, iters, res)
  else
!!     call init_eig_dd()                  !! very slow
!!     call eig_mtdagmt_dd(id)             !! very slow
!     call cg_def_r4(              x, b, id, ip, iters, res) !! very slow
     call cg_dd_r4(matrix,        x, b, id, ip, iters, res)
  endif
  cg_dd_outer_r4=iters
end

!-------------------------------------------------------------------------------
subroutine cg_all_dd_outer(x, b, mid, np, calc_sf)
  use module_cg
  use module_dd
  use module_function_decl
  implicit none
  integer :: mid, ip, np, calc_sf
  integer :: it_dummy
  COMPLEX, dimension(12,ld%lat%volh,0:ld%lat%num_ip-1), intent(inout):: x
  COMPLEX, dimension(12,ld%lat%volh*ld%lat%num_ip), intent(in)   :: b
  COMPLEX, dimension(12,ld%lat%volh) :: tmp
  integer, external :: cg_dd_outer
  integer :: i8, i4

  TIMING_START(timing_bin_cg_dd)
  call init_cg_stat2(dd_stat)
  do ip = 0,ld%lat%num_ip-1
     tmp(1:12,1:ld%lat%volh)=b(1:12,1+ip*ld%lat%volh:(ip+1)*ld%lat%volh)
     it_dummy = cg_dd_outer(WTDAGWT_DD, x(1,1,ip), tmp, mid, ip, calc_sf)
  enddo
  call get_cg_stat2(dd_stat, i8,i4)
  call iteration_count_is_d( i8,np)
  call iteration_count_is_d4(i4,np)
  TIMING_STOP(timing_bin_cg_dd)
end

!-------------------------------------------------------------------------------
subroutine cg_hh_outer(x, b, id, np, calc_sf)
  use module_cg
  use module_dd
  use module_function_decl
  implicit none
  integer, intent(in)  :: id, np, calc_sf
  COMPLEX, dimension(12*ld%lat%volh*gd%lat%volh*2), intent(inout):: x
  COMPLEX, dimension(12*ld%lat%volh*gd%lat%volh*2), intent(in)   :: b
  REAL :: res
  integer :: iters, i8, i4

  TIMING_START(timing_bin_cg_hh)
  DEBUG2S("Start: cg_hh_outer")

  call init_cg_stat2(dd_stat)
  call init_cg_stat2(hh_stat)
  call get_cg_res(res, calc_sf)

  select case(outer_solver)
     case("cg");    call cg_hh(    x, b, id, iters, res)
     case("cg_mix");call cg_hh_mix(x, b, id, iters, res)
     case default;  call die("cg_hh_outer: unknown solver: " // outer_solver )
  end select

  call get_cg_stat2(dd_stat, i8,i4)
  call iteration_count_is_d( i8,np)
  call iteration_count_is_d4(i4,np)

!write(0,*)"cg_hh_outer: result d8", i8
!write(0,*)"cg_hh_outer: result d4", i4

  call get_cg_stat2(hh_stat, i8,i4)
  call iteration_count_is_h( i8,np)
  call iteration_count_is_h4(i4,np)

!write(0,*)"cg_hh_outer: result h8", i8
!write(0,*)"cg_hh_outer: result h4", i4


  DEBUG2S("End: cg_hh_outer")
  TIMING_STOP(timing_bin_cg_hh)
end

!-------------------------------------------------------------------------------
subroutine cg_hh_inner(x, b, id, iters, res)
  use module_cg
  use module_dd
  implicit none
  integer, intent(in)  :: id
  complex(8), dimension(12*ld%lat%volh*gd%lat%volh*2), intent(inout):: x
  complex(8), dimension(12*ld%lat%volh*gd%lat%volh*2), intent(in)   :: b
  complex(4), dimension(12*ld%lat%volh*gd%lat%volh*2) :: x4, b4
  REAL, intent(in) :: res
  integer, intent(inout) :: iters
  integer :: iters_tmp

  DEBUG2S("Start: cg_hh_inner")
  x4=x ; b4=b
  call cg_hh_r4(        x4, b4, id, iters_tmp, res)
  iters = iters + iters_tmp
  x=x4
  DEBUG2S("End: cg_hh_inner")
end
#endif

!-------------------------------------------------------------------------------
subroutine cg_inner(x, b, id, iters, res)
  use module_input
  use module_cg
  use module_vol
  implicit none
  integer,                      intent(in)  :: id
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), intent(inout):: x
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), intent(in)   :: b
#ifndef BAGEL
  real(4), allocatable :: x4(:), b4(:)
  integer :: ierr
#endif
  REAL,        intent(in)  :: res
  integer,     intent(inout) :: iters
  integer                    :: iters_tmp

  DEBUG2S("Start: cg_inner")
#ifndef BAGEL
#ifdef IBM
  select case(inner_solver)
     case("cg");        call cg(      x, b, id, iters_tmp, res)
     case("bicgstab");  call bicgstab(x, b, id, iters_tmp, res)
     case default
        call die("cg_inner: unknown solver: " // inner_solver )
  end select
#else
  allocate(x4(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("allocation failed", 1, ierr)
     call die("cg_inner: allocation failed x4")
  endif
  allocate(b4(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("allocation failed", 1, ierr)
     call die("cg_inner: allocation failed b4")
  endif

  x4(1:SIZE_COMPLEX*NDIRAC*NCOL*volh)=real(x(1:SIZE_COMPLEX*NDIRAC*NCOL*volh))
  b4(1:SIZE_COMPLEX*NDIRAC*NCOL*volh)=real(b(1:SIZE_COMPLEX*NDIRAC*NCOL*volh))

  select case(inner_solver)
     case("cg")
        if (input%tuning_cg_loop_blocking /= 0) then
           call cg_block_r4(     x4, b4, id, iters_tmp, res)
        else
           call cg_r4(           x4, b4, id, iters_tmp, res)
        endif
     case("bicgstab");  call bicgstab_r4(x4, b4, id, iters_tmp, res)
     case default
        call die("cg_inner: unknown solver: " // inner_solver )
  end select

  x(1:SIZE_COMPLEX*NDIRAC*NCOL*volh)=dble(x4(1:SIZE_COMPLEX*NDIRAC*NCOL*volh))

  deallocate(x4, STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("deallocation failed", 1, ierr)
     call die("cg_inner: deallocation failed x4")
  endif
  deallocate(b4, STAT = ierr)
  if (ierr /= 0) then
     call stderr2_int("deallocation failed", 1, ierr)
     call die("cg_inner: deallocation failed b4")
  endif
#endif
#else
  select case(inner_solver)
     case("cg");        call cg(      x, b, id, iters_tmp, res)
     case("bicgstab");  call bicgstab(x, b, id, iters_tmp, res)
     case default
        call die("cg_inner: unknown solver: " // inner_solver )
  end select
#endif

  iters = iters + iters_tmp
  DEBUG2S("End: cg_inner")
end

#ifdef BQCD_DDHMC
!-------------------------------------------------------------------------------
integer function cg_dd_inner(matrix, x, b, id, ip, res)
  use module_dd
  implicit none
  integer, intent(in) :: matrix, id, ip
  complex(8), dimension(12*ld%lat%volh), intent(inout):: x
  complex(8), dimension(12*ld%lat%volh), intent(in)   :: b
  complex(4) :: x4(size(x)), b4(size(b))
  REAL,    intent(in)  :: res
  integer :: iters

  DEBUG2S("Start: cg_dd_inner")
  x4=x ; b4=b

!!  call init_eig_dd()                  !! very slow
!!  call eig_mtdagmt_dd(id)             !! very slow
!!  call cg_def_r4(          x4, b4, id, ip, iters, res) !! very slow
  call cg_dd_r4(matrix,   x4, b4, id, ip, iters, res)
  x=x4
  cg_dd_inner = iters
  DEBUG2S("End: cg_dd_inner")

end
#endif

!-------------------------------------------------------------------------------
!
! (A+b)a=x
!
subroutine shift_cg_outer(a, x, id, b, np, calc_sf)
  use module_cg
  use module_vol
  implicit none
  integer,        intent(in)  :: calc_sf, id, np ! np = n-th pseudo fermion
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(in)  :: x
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(out) :: a
  REAL, intent(in)                                        :: b
  REAL :: res
  integer :: iters

  call get_cg_res(res, calc_sf)
  call shift_cg_mix2(     a, x, id, b, iters, res)
  call iteration_count_is_f(iters, np)

end

!-------------------------------------------------------------------------------
!
! mcg_outer: results are put on "sco" at module_field temporarily
!            "b" must be (NDIRAC, NCOL, volh_tot)
!            "sco" must be (NDIRAC*NCOL*volh_tot)
!
subroutine mcg_outer(type, b, id, n, frdo, shift, iter_sh, np, calc_sf)
  use module_cg
  use module_vol
  use module_dd
  use module_function_decl
  use module_rhmc
  use module_action
  implicit none

  integer, intent(in) :: n, calc_sf, id, type, np ! np for iter count
  integer, intent(in) :: frdo(n)
  integer, intent(out):: iter_sh(n)
  REAL,    intent(in) :: shift(n)
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(in)  :: b

  REAL :: res, res_sh(n), time0, time1
  integer :: i, iters, i8, i4
  external :: wdagw_r8
#ifdef BQCD_DDHMC
  external :: wtdagwt_all_dd, unprec_hdagh
#endif
  SECONDS sekunden

  call mbcg_test()

  time0=sekunden()

  call get_cg_res(res, calc_sf)
  res_sh=res

  if (calc_sf == CG_MD .and. associated(relax)) then
     do i = 1, size(relax)
        res_sh(i)=res * relax(i)
     enddo
  endif

  select case(type)
     case(EO_RATIONAL)
        select case(outer_solver)
           case("cg")
              call multi_shift_cg(wdagw_r8,       id, n, frdo, shift, b, iters, iter_sh, res_sh)
#ifdef QUDA
           case("qudacg")
              call quda_cgm(      id, n, frdo, shift, b, iters, iter_sh, res_sh)
#endif
#ifdef MICVMULT
           case("vmcg")
              call vm_cgm(      id, n, frdo, shift, b, iters, iter_sh, res_sh)
#endif
           case default
              call die("cg_outer: unknown solver: " // outer_solver )
        end select
!!      call fom_shift(wdagw_r8,       id, n, frdo, shift, b, iters, iter_sh, res_sh)
!! not work
!!      call gmres_shift(wdagw_r8,       id, n, frdo, shift, b, iters, iter_sh, res_sh)
        call iteration_count_is_f(iters, np)
#ifdef BQCD_DDHMC
     case(DD_RATIONAL)
        call multi_shift_cg(wtdagwt_all_dd, id, n, frdo, shift, b, iters, iter_sh, res_sh)
!!        call fom_shift(     wtdagwt_all_dd, id, n, frdo, shift, b, iters, iter_sh, res_sh)
        call iteration_count_is_d( iters*ld%lat%num_ip,np)
     case(HH_RATIONAL)
        call init_cg_stat2(dd_stat)
        call multi_shift_cg(unprec_hdagh,   id, n, frdo, shift, b, iters, iter_sh, res_sh)
        call get_cg_stat2(dd_stat, i8,i4)
        call iteration_count_is_d( i8,np)
        call iteration_count_is_d4(i4,np)
        call iteration_count_is_h(iters,np)
#endif
  end select

end

!-------------------------------------------------------------------------------
!
! mcg_outer_z: results are put on "sco" at module_field temporarily
!            "b" must be (NDIRAC, NCOL, volh_tot)
!            "sco" must be (NDIRAC*NCOL*volh_tot)
!
! Complex version of mcg_outer
!
subroutine mcg_outer_z(b, id, n, frdo, shift, iter_sh, np, calc_sf)
  use module_cg
  use module_vol
  use module_dd
  use module_function_decl
  use module_rhmc
  implicit none

  integer, intent(in) :: n, calc_sf, id, np ! np for iter count
  integer, intent(in) :: frdo(n)
  integer, intent(out):: iter_sh(n)
  COMPLEX,    intent(in) :: shift(n)
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(in)  :: b

  REAL :: res, res_sh(n), time0, time1
  integer :: i, iters, i8, i4
  SECONDS sekunden

  external :: wdagw_r8

  time0=sekunden()
  call mbcg_test()
  call get_cg_res(res, calc_sf)
  res_sh=res

  if (calc_sf == CG_MD .and. associated(relax)) then
     do i = 1, size(relax)
        res_sh(i)=res * relax(i)
     enddo
  endif

  call multi_shift_cgz(wdagw_r8, id, n, frdo, shift, b, &
       iters, iter_sh, res_sh)
  call iteration_count_is_f(iters, np)

  time1 = sekunden()-time0
  if(my_pe()==0 )write(0,'(1x,"MCG done: np=",i2,1x,"nshifts=",i3,1x,"iter=",i12,1x, "Time=", g12.5)') &
  np, n, iters, time1

end subroutine mcg_outer_z

!-------------------------------------------------------------------------------
!
! mcr_outer_z: results are put on "sco" at module_field temporarily
!            "b" must be (NDIRAC, NCOL, volh_tot)
!            "sco" must be (NDIRAC*NCOL*volh_tot)
!
!  Conjugate residual method for complex shifts, solving
!+     (W + shift_i) sco_i = b
!+ where W = fermion matrix.
!-------------------------------------------------------------------------------
subroutine mcr_outer_z(b, id, n, frdo, shift, iter_sh, np, calc_sf)
  use module_cg
  use module_vol
  use module_dd
  use module_function_decl
  use module_rhmc
  implicit none

  integer, intent(in) :: n, calc_sf, id, np ! np for iter count
  integer, intent(in) :: frdo(n)
  integer, intent(out):: iter_sh(n)
  COMPLEX, intent(in) :: shift(n)
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(in)  :: b

  REAL :: res, res_sh(n), time0, time1
  integer :: i, iters, i8, i4
  SECONDS sekunden

  external :: g5wmul_r8

  time0=sekunden()
  call mbcg_test()
  call get_cg_res(res, calc_sf)
  res_sh=res

  if (calc_sf == CG_MD .and. associated(relax)) then
     do i = 1, size(relax)
        res_sh(i)=res * relax(i)
     enddo
  endif

  call multi_shift_crz(g5wmul_r8, id, n, frdo, shift, b, &
       iters, iter_sh, res_sh)
  call iteration_count_is_f(iters, np)

  time1 = sekunden()-time0
  if(my_pe()==0 )write(0,'(1x,"MCR done: np=",i2,1x,"nshifts=",i3,1x,"iter=",i12,1x, "Time=", g12.5)') &
  np, n, iters, time1

end

!-------------------------------------------------------------------------------
!
! mcr_outer_mat: results are put on "sco" at module_field temporarily
!            "b" must be (NDIRAC, NCOL, volh_tot)
!            "sco" must be (NDIRAC*NCOL*volh_tot)
!
!  Conjugate residual method for complex shifts, solving
!+     (M + shift_i) sco_i = b
!+ where M = the matrix given by subroutine 'matrix(out, in, id)'
!-------------------------------------------------------------------------------
subroutine mcr_outer_mat(b, matrix, id, n, frdo, shift, iter_sh, np, calc_sf)
  use module_cg
  use module_vol
  use module_dd
  use module_function_decl
  use module_rhmc
  use module_poly
  implicit none

  integer, intent(in) :: n, calc_sf, id, np ! np for iter count
  integer, intent(in) :: frdo(n)
  integer, intent(out):: iter_sh(n)
  COMPLEX, intent(in) :: shift(n)
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(in)  :: b

  REAL :: res, res_sh(n), time0, time1
  integer :: i, iters, i8, i4
  SECONDS sekunden

  external :: matrix

  time0=sekunden()
  call mbcg_test()
  call get_cg_res(res, calc_sf)
  res_sh=res

  if (calc_sf == CG_MD .and. associated(relax)) then
     do i = 1, size(relax)
        res_sh(i)=res * relax(i)
     enddo
  endif

  call multi_shift_crz(matrix, id, n, frdo, shift, b, &
       iters, iter_sh, res_sh)
  call iteration_count_is_f(iters, np)

  time1 = sekunden()-time0
  if(my_pe()==0 )write(0,'(1x,"MCRmat done: np=",i2,1x,"nshifts=",i3,1x,"iter=",i12,1x, "Time=", g12.5)') &
  np, n, iters, time1

end

!-------------------------------------------------------------------------------
subroutine mbcg_outer(type, id, b, mynl, mynr, frdo, shift, iter_sh, np, calc_sf)
  use module_cg
  use module_vol
  use module_function_decl
  use module_rhmc
  use multi_lr_solver
  implicit none

  integer, intent(in) :: mynl, mynr, calc_sf, id, type, np ! np for iter count
  integer, intent(in) :: frdo(mynl)
  integer, intent(out):: iter_sh(mynl)
  REAL,    intent(in) :: shift(mynl)
  REAL, dimension(24*volh_tot,mynr), intent(in)  :: b
  REAL :: tol0, tol(mynl)
  integer :: i, iters
  external :: wdagw_r8

  call mbcg_test()
  call get_cg_res(tol0, calc_sf)
  tol = tol0

  if (calc_sf == CG_MD .and. associated(relax))  tol(1:size(relax)) = tol0 * relax(1:size(relax))

  call set_multi_lr_solver(mynl, mynr, shift, tol)
  select case(type)
     case(EO_RATIONAL)
        call multi_shift_blockcg_qr(wdagw_r8, id, b, iters)
        call iteration_count_is_f(iters, np)
     case default
        call die("mbcg_outer: works only EO_RATIONAL type")
  end select

end

!-------------------------------------------------------------------------------
! cg_poly():
! Perform inversion of the given polynomial, P_pid(K)x = b
!-------------------------------------------------------------------------------
subroutine cg_poly(x, b, pid, np, calc_sf)
  use module_cg
  use module_vol
  use module_dd
  use module_function_decl
  use module_rhmc
  use module_poly
  use module_field
  implicit none

  integer, intent(in) :: calc_sf, pid, np ! np for iter count
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(in)  :: b
  COMPLEX, dimension(NDIRAC, NCOL, volh_tot), intent(out)  :: x

  external :: poly_mult
  external :: poly_hmult_full

  ! Call MRE pre-conditioned solver
  TIMING_START(timing_bin_cg_mre_matrix)
  call cg_mre_matrix(x, b, pid, np, calc_sf, poly_mult, poly_hmult_full)
  TIMING_STOP(timing_bin_cg_mre_matrix)

end subroutine cg_poly

!-------------------------------------------------------------------------------
! cg_outer_matrix():
! 'cg_outer' for general matrix inversions
!-------------------------------------------------------------------------------
subroutine cg_outer_matrix(x, b, id, np, calc_sf, matrix)
  use module_input
  use module_cg
  use module_vol
  use module_function_decl
  use module_action
  implicit none

  integer,        intent(in)  :: calc_sf, id, np ! np = n-th pseudo fermion
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), intent(inout):: x
  real(8), dimension(SIZE_COMPLEX*NDIRAC*NCOL*volh_tot), intent(in)   :: b
  external :: matrix ! Matrix to invert

  REAL :: res, time0, time1
  integer :: iters, iters4
  SECONDS sekunden

  DEBUG2S("Start: cg_outer_matrix")
  time0=sekunden()
#ifdef FPCOLL
call start_collection("cg_outer_matrix")
#endif
  call get_cg_res(res, calc_sf)

  select case(outer_solver)
     case("cg")
        call cg_matrix(x, b, id, np, iters, res, matrix)
     case default
        call die("cg_outer_matrix: unsupported solver: " // outer_solver )
  end select
  call iteration_count_is_f(iters, np)

  time1 = sekunden()-time0
  if(my_pe()==0 ) then
     write(0,'(1x,"CGmat done: np=",i2,1x,"mat(id=",i2,")",1x,"iter=",i12,1x, "Time=", g12.5)') &
  np, id, iters, time1
  endif

#ifdef FPCOLL
call stop_collection("cg_outer_matrix")
#endif
  DEBUG2S("End: cg_outer_matrix")

end

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