!===============================================================================
!
! eig_dd.F90 - program to calculate eigenmode by cg
!
!-------------------------------------------------------------------------------
!
! Copyright (C) 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_dd_evec
  use module_dd
!!  use module_mre2

  logical,save :: dd_evec     = .false.
  logical,save :: dd_evec_r4  = .false.

  type type_evec_dd
     real(8),pointer    :: eval(:)   ! (n)
     complex(8),pointer :: evalc(:)   ! (n)
     complex(8),pointer :: evalc_max
     complex(8),pointer :: x(:,:) ! (vec_len, n)
     complex(8),pointer :: ax(:,:) ! (vec_len, n)
     complex(8),pointer :: h(:,:)
     logical            :: fresh, &  !! whether A_present = A_last
                           initial   !! true, when making "x" from beginning
  end type type_evec_dd

  type type_evec_dd_r4
     real(4),pointer    :: eval(:)   ! (n)
     complex(4),pointer :: evalc(:)   ! (n)
     complex(4),pointer :: evalc_max
     complex(4),pointer :: x(:,:) ! (vec_len, n)
     complex(4),pointer :: ax(:,:) ! (vec_len, n)
     logical            :: fresh, initial
  end type type_evec_dd_r4

  integer, save :: defeig  ! say 20
  type(type_evec_dd),pointer,save :: evecdd(:,:)
  type(type_evec_dd_r4),pointer,save :: evecdd_r4(:,:)

end

!-------------------------------------------------------------------------------
subroutine init_eig_dd(n)
  use module_input
  use module_dd_evec
  implicit none
  integer :: ip,i,j,k,n

  if (input%solver_numdefvec_mtdmtdd==0) return
  if (dd_evec) return

  defeig=input%solver_numdefvec_mtdmtdd

  allocate(evecdd(0:ld%lat%num_ip-1,n))
  do k = 1, n
  do ip=0,ld%lat%num_ip-1
     evecdd(ip,k)%fresh=.false.
     evecdd(ip,k)%initial=.true.
     allocate(evecdd(ip,k)%eval(defeig))
     allocate(evecdd(ip,k)%evalc(defeig))
     allocate(evecdd(ip,k)%x(12*ld%lat%volh,defeig+1))
     allocate(evecdd(ip,k)%ax(12*ld%lat%volh,defeig))
     allocate(evecdd(ip,k)%h(defeig+1,defeig))
     do i = 1, defeig
     !$omp parallel do
     do j = 1, 12*ld%lat%volh
        evecdd(ip,k)%x(j,i) = (1,0)
     enddo
     enddo
  enddo
  enddo
  dd_evec = .true.
end

!-------------------------------------------------------------------------------
subroutine init_eig_dd_r4(n)
  use module_input
  use module_dd_evec
  implicit none
  integer :: ip,i,j,k,n

  if (input%solver_numdefvec_mtdmtdd==0) return
  if (dd_evec_r4) return

  defeig=input%solver_numdefvec_mtdmtdd

  allocate(evecdd_r4(0:ld%lat%num_ip-1,n))
  do k = 1, n
  do ip=0,ld%lat%num_ip-1
     evecdd_r4(ip,k)%fresh=.false.
     evecdd_r4(ip,k)%initial=.true.
     allocate(evecdd_r4(ip,k)%eval(defeig))
     allocate(evecdd_r4(ip,k)%evalc(defeig))
     allocate(evecdd_r4(ip,k)%x(12*ld%lat%volh,defeig))
     do i = 1, defeig
     !$omp parallel do
     do j = 1, 12*ld%lat%volh
        evecdd_r4(ip,k)%x(j,i) = (1,0)
     enddo
     enddo
  enddo
  enddo
  dd_evec_r4 = .true.
end

!-------------------------------------------------------------------------------
subroutine eig_mtmul_dd(id)
  use module_function_decl
  use module_dd_evec
  implicit none
  integer, intent(in)  :: id  ![action 0:1 = min:max]
  integer :: iter, ip, nip, iterall
  real(8) :: tmp

  DEBUG2S("Start: test_cg_ritz_dd_loop")

  if (evecdd(0,1)%fresh) return

  iterall=0
  do ip=0,ld%lat%num_ip-1
#ifdef ARPACK
call eig_mtmul_dd_loop(id,ip,defeig,evecdd(ip,1)%evalc(1),evecdd(ip,1)%x(1,1),iter)
#else
call die("this version does not support eig_mtmul_dd")
#endif
     iterall=iterall+iter
     evecdd(ip,1)%fresh=.true.
  enddo
  tmp=iterall
  tmp=global_sum(tmp)
  iterall=tmp
  if (my_pe()==0)write(0,*)"eig_mtmul_dd (nvec, iter):",defeig,iterall
  DEBUG2S("End: test_cg_ritz_dd_loop")

end

!-------------------------------------------------------------------------------
subroutine eig_mtdagmt_dd(id)
  use module_function_decl
  use module_dd_evec
  implicit none
  integer, intent(in)  :: id  ![action 0:1 = min:max]
  integer :: iter, ip, nip, iterall
  real(8) :: tmp

  DEBUG2S("Start: test_cg_ritz_dd_loop")

  if (evecdd(0,1)%fresh) return

  iterall=0
  do ip=0,ld%lat%num_ip-1
#ifdef ARPACK
call eig_mtdagmt_dd_loop(id,ip,defeig,evecdd(ip,1)%eval(1),evecdd(ip,1)%x(1,1),iter)
#else
call die("this version does not support eig_mtdagmt_dd")
#endif
     iterall=iterall+iter
     evecdd(ip,1)%fresh=.true.
  enddo
  tmp=iterall
  tmp=global_sum(tmp)
  iterall=tmp
  if (my_pe()==0)write(0,*)"eig_mtdagmt_dd (nvec, iter):",defeig,iterall
  DEBUG2S("End: test_cg_ritz_dd_loop")

end

!-------------------------------------------------------------------------------
subroutine eig_mtdagmt_dd_r4(id)
  use module_function_decl
  use module_dd_evec
  implicit none
  integer, intent(in)  :: id  ![action 0:1 = min:max]
  integer :: iter, ip, nip, iterall
  real (8):: tmp

  DEBUG2S("Start: test_cg_ritz_dd_loop")

  if (evecdd_r4(0,1)%fresh) return
  iterall=0
  do ip=0,ld%lat%num_ip-1
#ifdef ARPACK
call eig_mtdagmt_dd_loop_r4(id,ip,defeig,evecdd_r4(ip,1)%eval(1),evecdd_r4(ip,1)%x(1,1),iter)
#else
call die("this version does not support eig_mtdagmt_dd_r4")
#endif
     iterall=iterall+iter
     evecdd_r4(ip,1)%fresh=.true.
  enddo
  tmp=iterall
  tmp=global_sum(tmp)
  iterall=tmp
  if (my_pe()==0)write(0,*)"eig_mtdagmt_dd_r4 (nvec, iter):",defeig,iterall
  DEBUG2S("End: test_cg_ritz_dd_loop")

end

!-------------------------------------------------------------------------------
subroutine test_cg_ritz_dd_loop(id)
  use module_function_decl
  use module_dd_evec
  implicit none
  integer, intent(in)  :: id  ![action 0:1 = min:max]
  integer :: iter, ip, nip, iterall
  real (8):: tmp

  DEBUG2S("Start: test_cg_ritz_dd_loop")

  if (evecdd(0,1)%fresh) return

  iterall=0
!!  call mre2_dd_evec_get(id)
  do ip=0,ld%lat%num_ip-1
     call cg_ritz_dd_loop(id,ip,defeig,evecdd(ip,1),iter,0)
     iterall=iterall+iter
     evecdd(ip,1)%fresh=.true.
  enddo
!!  call mre2_dd_evec_put()
  tmp=iterall
  tmp=global_sum(tmp)
  iterall=tmp
  if (my_pe()==0)write(0,*)"cg_ritz_dd (nvec, iter):",defeig,iterall
  DEBUG2S("End: test_cg_ritz_dd_loop")

end

!!!-------------------------------------------------------------------------------
!!subroutine mre2_dd_evec_put()
!!  use module_vol
!!  use module_dd_evec
!!  implicit none
!!!!  complex(8):: a(12*ld%lat%volh,0:ld%lat%num_ip-1)
!!  complex(8):: a(12*volh)
!!  integer :: ieig, ip, nv
!!
!!  nv=12*ld%lat%volh
!!  do ieig = 1, defeig
!!     do ip=0,ld%lat%num_ip-1
!!        a(1+nv*ip:nv*(ip+1))=evecdd(ip)%x(1:nv,ieig)
!!     enddo                              ! no reset
!!     call mre2_put(pastevecdd(ieig), a, 0, 12*volh)
!!  enddo
!!end
!!!-------------------------------------------------------------------------------
!!subroutine mre2_dd_evec_get(id)
!!  use module_vol
!!  use module_dd_evec
!!  use mre2_get_interface
!!  implicit none
!!!!  complex(8), dimension(12*ld%lat%volh,0:ld%lat%num_ip-1) :: a, x
!!  complex(8), dimension(12*volh) :: a, x
!!  external :: mtmul_all_dd, wtdagwt_all_dd
!!  integer :: ieig, ip,id, nv
!!
!!  nv=12*ld%lat%volh
!!  do ieig = 1, defeig
!!     do ip=0,ld%lat%num_ip-1
!!        x(1+nv*ip:nv*(ip+1))=evecdd(ip)%x(1:nv,ieig)
!!     enddo
!!     call mre2_get(mtmul_all_dd, pastevecdd(ieig), a, x, id)
!!     do ip=0,ld%lat%num_ip-1
!!        evecdd(ip)%x(1:nv,ieig)=a(1+nv*ip:nv*(ip+1))
!!     enddo
!!  enddo
!!end
!-------------------------------------------------------------------------------
subroutine cg_ritz_dd_loop(id, ip, n, evecs, iter, action)
  use module_dd_evec
  implicit none
  integer, intent(in)  :: ip, id, n, action  ![action 0:1 = min:max]
  integer, intent(out) :: iter
  type(type_evec_dd), intent(out) :: evecs
  integer :: i, ierr, niter,j
  real(8) :: norm, inv
  complex(8),dimension(12*ld%lat%volh) :: tmp
  complex(8),external:: ddsc_cdotc
  real(8),external   :: ddsc_norm2


  DEBUG2S("Start: cg_ritz_dd_loop")
  iter = 0
  do i = 1, n
     call orthogonalize_vecdd(i-1, evecs, evecs%x(1,i))
     call normalize_vecdd(evecs%x(1,i), norm)
     call cg_ritz_dd(ip, id, niter, evecs, i-1, action)
     iter = iter + niter
  enddo

!  call gram_schmidt(evecs%x(1,1), 12*ld%lat%volh, n, .false.)
!  do i =1 ,n
!     call mtdagmt_dd(tmp,evecs%x(1,i),id,ip)
!     norm = ddsc_norm2(tmp)
!     inv=ONE/sqrt(norm)
!     evecs%x(:,i)=evecs%x(:,i)*inv
!     evecs%ax(:,i)=tmp*inv
!  enddo
!  call gram_schmidt(evecs%ax(1,1), 12*ld%lat%volh, n, .false.)

!!  call mtdagmt_dd(tmp,evecs%x(1,1),id,ip)
!!  norm=ddsc_norm2(evecs%ax(1,1))
!!  write(0,*)norm
!!  write(0,*)tmp(1),evecs%ax(1,1)
!!  write(0,*)tmp(2),evecs%ax(2,1)
!!  write(0,*)tmp(3),evecs%ax(3,1)
!!  stop


  DEBUG2S("End: cg_ritz_dd_loop")
end

!-------------------------------------------------------------------------------
subroutine cg_ritz_dd(ip, id, iter, evecs, n, action)
  use module_dd_evec
  use module_function_decl
  use module_cg
  implicit none
  integer, intent(in)  :: action, ip, id, n  ![action 0:1 = min:max]
  integer, intent(out) :: iter
  type(type_evec_dd),intent(inout) :: evecs

  complex(8),dimension(12*ld%lat%volh) :: x
  complex(8),dimension(12*ld%lat%volh) :: y  ! y = Ax
  complex(8),dimension(12*ld%lat%volh) :: g  ! g = Ax - mu x
  complex(8),dimension(12*ld%lat%volh) :: p  ! search direction
  complex(8),dimension(12*ld%lat%volh) :: z  ! z = Ap

  real(8)                    :: beta, pp, pap, rtr, rtrold, xp,mu
  real(8)                    :: costheta, sintheta
  integer                 :: i, niter, ierr, j
  complex(8),external:: ddsc_cdotc
  real(8),external   :: ddsc_norm2

  DEBUG2S("Start: cg_ritz_dd")
  TIMING_START(timing_bin_cg_ritz)

  x(1:12*ld%lat%volh)=evecs%x(1:12*ld%lat%volh,n+1)

  call mtdagmt_dd(y,x,id,ip)
  call orthogonalize_vecdd(n, evecs, y)

  mu = ddsc_cdotc(x, y)
  g = y - mu * x
  p = g
  rtr = ddsc_norm2(g)

  do niter = 1, cg_para%maxiter
     if (sqrt(rtr) <= cg_para%rest_domain_def) goto 9999

     call orthogonalize_vecdd(n, evecs, p)
     pp =  ddsc_norm2(p)

     call mtdagmt_dd(z,p,id,ip)
     call orthogonalize_vecdd(n, evecs, z)
     pap = ddsc_cdotc(p, z)

     call min_ritz_func(mu, costheta, sintheta, rtr, pap, pp, action)
     call ddsc_axpby(x, p, costheta, sintheta)  ! x = costheta * x + sintheta * p
     call ddsc_axpby(y, z, costheta, sintheta)  ! y = costheta * y + sintheta * z
!     x = costheta * x + sintheta * p
!     y = costheta * y + sintheta * z

     rtrold = rtr
     g = y - mu * x
     rtr = ddsc_norm2(g)

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

     beta = costheta * rtr / rtrold
     xp = ddsc_cdotc(x, p)
     p = g + beta * ( p - xp * x )
  enddo

  niter = niter - 1

  if (cg_para%log /= 2) then
     if(my_pe()==0)write(UREC, *) "cg_ritz(): no convergence; rtr = ", rtr 
     write(0, *) "cg_ritz(): no convergence; rtr = ", rtr 
     stop
  endif

9999 continue
!=================================================
  if (cg_para%check /= 0) call check_cg_ritz_dd(ip, id, niter, mu, x)

!  call update_cg_stat(cg_ritz_stat, niter, 0)

  iter = niter
  evecs%eval(n+1)=mu
  evecs%x(1:12*ld%lat%volh,n+1)=x(1:12*ld%lat%volh)

  TIMING_STOP(timing_bin_cg_ritz)
  DEBUG2S("End: cg_ritz_dd")
end

!-------------------------------------------------------------------------------
subroutine check_cg_ritz_dd(ip, id, niter, mu, x)
  use module_function_decl
  use module_dd
  implicit none
  integer, intent(in) :: ip, id, niter
  REAL,    intent(in) :: mu
  REAL :: res
  integer, save :: count = 0
  complex(8),dimension(12*ld%lat%volh) :: x, tmp
  real(8),external   :: ddsc_norm2

  if(my_pe()==0 .and. count == 0) write(UREC,400)"T%cg_ritz_dd",  &
     " niter","mu", " sum^Vol|mux-Mx|^2"
  call mtdagmt_dd(tmp,x,id,ip)
  tmp = tmp - mu * x
  res = ddsc_norm2(tmp)
  if(my_pe()==0)  write(UREC,410)" %cg_ritz_dd",  niter, mu, res
  count = 1
400 format (1x,a12, a6,1x,2a18)
410 format (1x,a12 ,i6,1x,2es18.6)
end

!-------------------------------------------------------------------------------
subroutine normalize_vecdd(inout, norm)
  use module_dd
  implicit none
  complex(8), intent(inout) :: inout(12*ld%lat%volh)
  real(8), intent(out) :: norm
  real(8) :: tmp
  real(8),external :: ddsc_norm2

  tmp = ddsc_norm2(inout) 
  norm = sqrt(tmp)
  tmp = ONE / norm
  inout= inout*tmp
end

!-------------------------------------------------------------------------------
subroutine orthogonalize_vecdd(n, evecs, inout)
  use module_dd_evec
  implicit none
  type(type_evec_dd),intent(in) :: evecs
  complex(8), intent(inout) :: inout(12*ld%lat%volh)
  integer, intent(in) :: n
  complex(8) :: xx(n)
  integer :: i, j
  complex(8),external:: ddsc_cdotc

  do i = 1, n
    xx(i)=ddsc_cdotc(evecs%x(1,i), inout)
    call ddsc_caxpy(inout, evecs%x(1,i), -xx(i))
  enddo
end

!-------------------------------------------------------------------------------
subroutine check_orthonormal_vecdd(n, evecs)
  use module_dd_evec
  use module_function_decl
  implicit none
  type(type_evec_dd),intent(in) :: evecs
  integer, intent(in) :: n
  complex(8) :: xx
  REAL :: res
  integer :: i, j
  complex(8),external:: ddsc_cdotc

  res = ZERO
  do i = 1, n
     do j = 1, n
        xx = ddsc_cdotc(evecs%x(1,i), evecs%x(1,j))

        if (i==j)then
           res = res + ( real(xx) - ONE )**2
           res = res + (aimag(xx) )**2
        else
           res = res + ( real(xx) )**2
           res = res + (aimag(xx) )**2
        endif
     enddo
  enddo

  write(0,*)"ck_orthonormal_vecdd: ","n=",n,"sumdif=",res

end

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