!===============================================================================
!
! check_solution.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/>.
!
!-------------------------------------------------------------------------------
# include "defs.h"

  !//
  !//  Rx = |M x - b|^2  /  |x|^2
  !//  Rb = |M x - b|^2  /  |b|^2
  !//

module module_check_solution

  implicit none

  interface check_solution

     subroutine check_solution_r8(id, x, b, norm)
        real(8), dimension(:), intent(in) :: x, b
        integer,               intent(in) :: id
        real(8),               intent(out):: norm(3)
     end 
     subroutine check_solution_r4(id, x, b, norm)
        real(4), dimension(:), intent(in) :: x, b
        integer,               intent(in) :: id
        real(8),               intent(out):: norm(3)
     end
     subroutine check_solution_c8(id, x, b, norm)
        complex(8), dimension(:), intent(in) :: x, b
        integer,               intent(in) :: id
        real(8),               intent(out):: norm(3)
     end 
     subroutine check_solution_c4(id, x, b, norm)
        complex(4), dimension(:), intent(in) :: x, b
        integer,               intent(in) :: id
        real(8),               intent(out):: norm(3)
     end

  end interface check_solution

#ifdef DD
  interface check_solution_dd

     subroutine check_solution_dd_r8(id, x, b, norm)
        real(8), dimension(:), intent(in) :: x, b
        integer,               intent(in) :: id
        real(8),               intent(out):: norm(3)
     end 
     subroutine check_solution_dd_r4(id, x, b, norm)
        real(4), dimension(:), intent(in) :: x, b
        integer,               intent(in) :: id
        real(8),               intent(out):: norm(3)
     end

  end interface check_solution_dd
#endif
end module module_check_solution

!-------------------------------------------------------------------------------
subroutine check_solution_r8(id, x, b, norm) 
  use module_vol
  use module_p_interface
  implicit none
  real(8), dimension(:), intent(in) :: x, b
  integer,               intent(in) :: id
  real(8),               intent(out):: norm(3)
  real(8), dimension(:), pointer, save :: r
  integer :: i

  if (.not. associated(r)) call allocate_sc_overindexed(r)

  call wdagw_r8(r, x, id)

  norm = 0
  !$omp parallel do reduction(+: norm)
  do i = 1, size_sc_field
     norm(1) = norm(1) + (r(i) - b(i))**2
     norm(2) = norm(2) + b(i)**2
     norm(3) = norm(3) + x(i)**2
  enddo

  call global_sum_vec(3, norm)

end

!-------------------------------------------------------------------------------
subroutine check_solution_r4(id, x, b, norm) 
  use module_vol
  use module_p_interface_r4
  implicit none
  real(4), dimension(:), intent(in) :: x, b
  integer,               intent(in) :: id
  real(8),               intent(out):: norm(3)
  real(4), dimension(:), pointer, save :: r
  integer :: i

  if (.not. associated(r)) call allocate_sc_overindexed_r4(r)

  call wdagw_r4(r, x, id)

  norm = 0
  !$omp parallel do reduction(+: norm)
  do i = 1, size_sc_field
     norm(1) = norm(1) + (dble(r(i) - b(i)))**2
     norm(2) = norm(2) + (dble(b(i)       ))**2
     norm(3) = norm(3) + (dble(x(i)       ))**2
  enddo

  call global_sum_vec(3, norm)

end
!-------------------------------------------------------------------------------
subroutine check_solution_c8(id, x, b, norm) 
  use module_vol
  implicit none
  complex(8), dimension(:), intent(in) :: x, b
  integer,               intent(in) :: id
  real(8),               intent(out):: norm(3)
  complex(8), dimension(:), pointer, save :: r
  integer :: i

  if (.not. associated(r)) allocate(r(4*3*volh_tot))

  call wdagw_r8(r, x, id)

  norm = 0
  !$omp parallel do reduction(+: norm)
  do i = 1, size_sc_field/2
     norm(1) = norm(1) + (r(i) - b(i))*conjg(r(i) - b(i))
     norm(2) = norm(2) + b(i)*conjg(b(i))
     norm(3) = norm(3) + x(i)*conjg(x(i))
  enddo

  call global_sum_vec(3, norm)

end

!-------------------------------------------------------------------------------
subroutine check_solution_c4(id, x, b, norm) 
  use module_vol
  implicit none
  complex(4), dimension(:), intent(in) :: x, b
  integer,               intent(in) :: id
  real(8),               intent(out):: norm(3)
  complex(4), dimension(:), pointer, save :: r
  integer :: i

  if (.not. associated(r)) allocate(r(4*3*volh_tot))

  call wdagw_r4(r, x, id)

  norm = 0
  !$omp parallel do reduction(+: norm)
  do i = 1, size_sc_field/2
     norm(1) = norm(1) + (dble(real(r(i)) - real(b(i))))**2
     norm(2) = norm(2) + (dble(real(b(i))             ))**2
     norm(3) = norm(3) + (dble(real(x(i))             ))**2
     norm(1) = norm(1) + (dble(imag(r(i)) - imag(b(i))))**2
     norm(2) = norm(2) + (dble(imag(b(i))             ))**2
     norm(3) = norm(3) + (dble(imag(x(i))             ))**2
  enddo

  call global_sum_vec(3, norm)

end






!-------------------------------------------------------------------------------
#ifdef DD
subroutine check_solution_dd_r8(id, x, b, norm) 
  use module_vol
  use module_p_interface
  implicit none
  real(8), dimension(:), intent(in) :: x, b
  integer,               intent(in) :: id
  real(8),               intent(out):: norm(3)
  real(8), dimension(:), pointer, save :: r
  integer :: i

  if (.not. associated(r)) call allocate_sc_overindexed(r)

  call wdagw_dd(r, x, id)

  norm = 0
  !$omp parallel do reduction(+: norm)
  do i = 1, size_sc_field
     norm(1) = norm(1) + (r(i) - b(i))**2
     norm(2) = norm(2) + b(i)**2
     norm(3) = norm(3) + x(i)**2
  enddo

  call global_eo_sum_vec(3, norm)
!!  call global_sum_vec(3, norm)

end

!-------------------------------------------------------------------------------
subroutine check_solution_dd_r4(id, x, b, norm) 
  use module_vol
  use module_p_interface
  implicit none
  real(4), dimension(:), intent(in) :: x, b
  integer,               intent(in) :: id
  real(8),               intent(out):: norm(3)
  real(4), dimension(:), pointer, save :: r
  integer :: i

  if (.not. associated(r)) call allocate_sc_overindexed_r4(r)

!!  call wdagw_dd_r4(r, x, id)
call die("check_solution_dd_r4 have not implemented")

  norm = 0
  !$omp parallel do reduction(+: norm)
  do i = 1, size_sc_field
     norm(1) = norm(1) + (dble(r(i) - b(i)))**2
     norm(2) = norm(2) + (dble(b(i)       ))**2
     norm(3) = norm(3) + (dble(x(i)       ))**2
  enddo

  call global_eo_sum_vec(3, norm)
!!  call global_sum_vec(3, norm)

end
#endif
!===============================================================================
