!===============================================================================
!
! cg_dd.F90 - cg for DD
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 2009 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"

!-------------------------------------------------------------------------------
subroutine cg_dd(matrix, x, b, id, ip, iter, res) 
  use module_function_decl
  use module_action
  use module_cg
  use module_dd
  implicit none

  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(inout):: x
  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(in)   :: b

  integer,              intent(out)   :: iter
  integer,              intent(in)    :: id, ip
  DOUBLE,               intent(in)    :: res

  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh) :: r, p, aap
  REAL          :: ak, bk
  DOUBLE        :: rtr, rtrold, paap, bb, dtmp, dtmp1, dtmp2
  integer       :: i, niter, sc_size
  integer :: matrix
  character(72) :: msg
!-------------------------------------------------------------------------------
  sc_size = SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh

  bb = 0
  !$omp parallel do reduction(+: bb) private(dtmp)
  do i = 1, sc_size
     dtmp = b(i)
     bb = bb + dtmp**2
  enddo

  if (matrix == WTDAGWT_DD) then
     call wtdagwt_dd(r, x, id, ip)
  else
     call mtdagmt_dd(r, x, id, ip)
  endif

  niter = 1

  rtrold = 0
  !$omp parallel do reduction(+: rtrold) private(dtmp)
  do i = 1, sc_size
     r(i) = b(i) - r(i)
     p(i) = r(i)
     dtmp = r(i)
     rtrold = rtrold + dtmp**2
  enddo
  if (stop_condition(rtrold, res, bb)) goto 9999

  do niter = 1, cg_para%maxiter
     if (matrix == WTDAGWT_DD) then
        call wtdagwt_dd(aap, p, id, ip)
     else
        call mtdagmt_dd(aap, p, id, ip)
     endif

     paap = 0
     !$omp parallel do reduction(+: paap) private(dtmp1, dtmp2)
     do i = 1, sc_size
        dtmp1 = p(i)
        dtmp2 = aap(i)
        paap = paap + dtmp1 * dtmp2
     enddo

     ak = rtrold / paap
     rtr = 0
     !$omp parallel do reduction(+: rtr) private(dtmp)
     do i = 1, sc_size
        x(i) = x(i) + ak * p(i)
        r(i) = r(i) - ak * aap(i)
        dtmp = r(i)
        rtr = rtr + dtmp**2
     enddo

#ifdef DEBUG2
     if(my_pe()==0 .and. mod(niter,100)==0  )write(0,*)niter,"ddrtr",rtr
#endif

     if (stop_condition(rtr, res, bb)) goto 9999
     bk = rtr / rtrold
     rtrold = rtr
     p = r + bk * p
  enddo
  niter = niter - 1
  if (cg_para%log /= 2) then
     write(msg, *) "cg_dd(): no convergence; rtr = ", rtr,RKIND
     call die(msg)
  endif
9999 continue
  iter=niter
#if RKIND == 8
  call update_cg_stat(dd_stat, iter, 0)
#else
  call update_cg_stat(dd_stat, 0, iter)
#endif
end


!-------------------------------------------------------------------------------
subroutine cg_dd2(matrix, x, b, id, ip, iter, res, maxiter) 
  use module_function_decl
  use module_action
  use module_cg
  use module_dd
  implicit none

  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(inout):: x
  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(in)   :: b

  integer,              intent(out)   :: iter
  integer,              intent(in)    :: id, ip, maxiter
  DOUBLE,               intent(in)    :: res

  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh) :: r, p, aap
  REAL          :: ak, bk
  DOUBLE        :: rtr, rtrold, paap, bb, dtmp, dtmp1, dtmp2
  integer       :: i, niter, sc_size
  integer :: matrix
  character(72) :: msg
!-------------------------------------------------------------------------------
  sc_size = SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh

  bb = 0
  !$omp parallel do reduction(+: bb)
  do i = 1, sc_size
     dtmp = b(i)
     bb = bb + dtmp**2
  enddo

  if (matrix == WTDAGWT_DD) then
     call wtdagwt_dd(r, x, id, ip)
  else
     call mtdagmt_dd(r, x, id, ip)
  endif

  niter = 1

  rtrold = 0
  !$omp parallel do reduction(+: rtrold)
  do i = 1, sc_size
     r(i) = b(i) - r(i)
     p(i) = r(i)
     dtmp = r(i)
     rtrold = rtrold + dtmp**2
  enddo
  if (stop_condition(rtrold, res, bb)) goto 9999

  do niter = 1, maxiter
     if (matrix == WTDAGWT_DD) then
        call wtdagwt_dd(aap, p, id, ip)
     else
        call mtdagmt_dd(aap, p, id, ip)
     endif

     paap = 0
     !$omp parallel do reduction(+: paap)
     do i = 1, sc_size
        dtmp1 = p(i)
        dtmp2 = aap(i)
        paap = paap + dtmp1 * dtmp2
     enddo

     ak = rtrold / paap
     rtr = 0
     !$omp parallel do reduction(+: rtr)
     do i = 1, sc_size
        x(i) = x(i) + ak * p(i)
        r(i) = r(i) - ak * aap(i)
        dtmp = r(i)
        rtr = rtr + dtmp**2
     enddo

#ifdef DEBUG2
     if(my_pe()==0 .and. mod(niter,100)==0  )write(0,*)niter,"dd2rtr",rtr
#endif
     if (stop_condition(rtr, res, bb)) goto 9999
     bk = rtr / rtrold
     rtrold = rtr
     p = r + bk * p
  enddo

9999 continue

  iter=niter

end

!-------------------------------------------------------------------------------
subroutine bicgstab_dd(matrix, x, b, id, ip, iter, res) 
  use module_function_decl
  use module_action
  use module_cg
  use module_dd
  implicit none

!  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(inout):: x
!  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh), intent(in)   :: b
!  REAL, dimension(SIZE_COMPLEX*NDIRAC*NCOL*ld%lat%volh) :: r, r0, p, aap, s, aas
  COMPLEX, dimension(12*ld%lat%volh), intent(inout):: x
  COMPLEX, dimension(12*ld%lat%volh), intent(in)   :: b
  COMPLEX, dimension(12*ld%lat%volh) :: r, r0, p, aap, s, aas

  integer,              intent(out)   :: iter
  integer,              intent(in)    :: id, ip, matrix
  DOUBLE,               intent(in)    :: res
  COMPLEX:: paap, ak, bk, omega, ss(2)!, rtrold, rtr

  DOUBLE        :: bb, dtmp, dtmp1, dtmp2, rtrold, rtr
  integer       :: i, niter, sc_size
  character(72) :: msg
  COMPLEX,external :: ddsc_cdotc
  REAL,external    :: ddsc_norm2
!-------------------------------------------------------------------------------
  sc_size = 12*ld%lat%volh

  bb = ddsc_norm2(b)

  select case (matrix)
     case(MTMUL_DD);call mtmul_dd(r, x, id, ip)
     case(MTDAG_DD);call mtdag_dd(r, x, id, ip)
  end select
  niter = 1

  r = b - r
  r0= r
  p = r
  rtrold = ddsc_norm2(r)
  if (stop_condition(dble(rtrold), res, bb)) goto 9999

  do niter = 1, cg_para%maxiter
     select case (matrix)
        case(MTMUL_DD);call mtmul_dd(aap, p, id, ip)
        case(MTDAG_DD);call mtdag_dd(aap, p, id, ip)
     end select

     paap = ddsc_cdotc(aap,r0)

     ak = rtrold / paap
     s = r - ak * aap

     select case (matrix)
        case(MTMUL_DD);call mtmul_dd(aas, s, id, ip)
        case(MTDAG_DD);call mtdag_dd(aas, s, id, ip)
     end select

     ss(1)=ddsc_cdotc(s,aas)
     ss(2)=ddsc_cdotc(aas,aas)
     omega = ss(1)/ss(2)

     x = x + ak * p + omega * s
     r = s          - omega * aas

     ss(1)=ddsc_cdotc(r,r)
     ss(2)=ddsc_cdotc(r,r0)

write(0,*)ss

     rtr =  ss(1)
!write(0,*)rtr,res,bb
     if (stop_condition(dble(rtr), res, bb)) goto 9999

     bk = ss(2) / rtrold * ak / omega
     rtrold = ss(2)
     p = r + bk * (p - omega * aap)
  enddo

  niter = niter - 1

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

9999 continue

  iter=niter
#if RKIND == 8
  call update_cg_stat(dd_stat, iter, 0)
#else
  call update_cg_stat(dd_stat, 0, iter)
#endif

!  select case (matrix)
!     case(MTMUL_DD);call mtmul_dd(r, x, id, ip)
!     case(MTDAG_DD);call mtdag_dd(r, x, id, ip)
!  end select
!  rtr = ZERO
!  !$omp parallel do reduction(+: rtr)
!  do i = 1, sc_size
!     r(i) = b(i) - r(i)
!     rtr = rtr + conjg(r(i))*r(i)
!  enddo
!write(0,*)rtr

end

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