!> @file
!! Solve the preconditioning equation for the linear version
!! @author
!!    Copyright (C) 2011-2013 BigDFT group
!!    This file is distributed under the terms of the
!!    GNU General Public License, see ~/COPYING file
!!    or http://www.gnu.org/copyleft/gpl.txt .
!!    For the list of contributors, see ~/AUTHORS


!> Solves the preconditioning equation by conjugate gradient iterations.
!! The equation reads ( kin.energy + cprecr*Id + potentialPrefac*(r-r0)^4 )x=y
!! Solves (KE+cprecr*I)*xx=yy by conjugate gradient method.
!! x is the right hand side on input and the solution on output
subroutine solvePrecondEquation(lr,ncplx,ncong,cprecr,&
     hx,hy,hz,kx,ky,kz,x,  rxyzParab, potentialPrefac, confPotOrder, &
     work_conv, w)

  use liborbs_precisions
  use locregs
  use locreg_operations
  use dynamic_memory
  use wrapper_linalg

  implicit none
  integer, intent(in) :: ncong                !> number of CG iterations
  integer, intent(in) :: ncplx                !> real or complex??
  integer, intent(in) :: confPotOrder         
  real(gp), intent(in) :: hx,hy,hz            !> hgrid in x, y and z direction
  real(gp), intent(in) :: cprecr              !> preconditioning constant
  real(gp), intent(in) :: kx,ky,kz            !> kpoints in x, y and z direction
  type(locreg_descriptors), intent(in) :: lr  !> Type describing the localization region
  !> on input: the right hand side of the equation (i.e. y)
  !! on output: the solution of the equation (i.e. x)
  real(wp), dimension((lr%wfd%nvctr_c+7*lr%wfd%nvctr_f)*ncplx), intent(inout) :: x
  real(kind=8), dimension(3), intent(in) :: rxyzParab !> the center of the confinement potential
!  type(orbitals_data), intent(in) :: orbs     !> type describing the orbitals
  real(kind=8) :: potentialPrefac             !> prefactor for the confinement potential
  type(workarrays_quartic_convolutions),intent(inout):: work_conv !< workarrays for the convolutions
  type(workarr_precond),intent(inout) :: w !< workarrays

  ! Local variables
  character(len=*), parameter :: subname='precondition_residue'
  real(gp), dimension(0:7) :: scal
  real(wp) :: rmr_old,rmr_new,alpha,beta
  integer :: icong
  real(wp), dimension(:), allocatable :: b,r,d
  logical:: with_confpot

  call f_routine(id='solvePrecondEquation')

  !!type(workarrays_quartic_convolutions):: work_conv

  !arrays for the CG procedure
  b = f_malloc(ncplx*(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f),id='b')
  r = f_malloc(ncplx*(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f),id='r')
  d = f_malloc(ncplx*(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f),id='d')

  !call allocate_work_arrays(lr%geocode,lr%hybrid_on,ncplx,lr%d,w)

  !call precondition_preconditioner(lr,ncplx,hx,hy,hz,scal,cprecr,w,x,b)
  call precondition_preconditioner(lr,ncplx,hx,hy,hz,scal,cprecr,w,x,r)

  with_confpot=(potentialPrefac/=0.d0)
  !!call init_local_work_arrays(lr%d%n1, lr%d%n2, lr%d%n3, &
  !!     lr%d%nfl1, lr%d%nfu1, lr%d%nfl2, lr%d%nfu2, lr%d%nfl3, lr%d%nfu3, &
  !!     with_confpot, work_conv)
  call zero_local_work_arrays(lr%d%n1, lr%d%n2, lr%d%n3, &
       with_confpot, work_conv)
  !!call allocate_workarrays_quartic_convolutions(lr, subname, work_conv)
  call differentiateBetweenBoundaryConditions(ncplx,lr,hx,hy,hz,kx,ky,kz,cprecr,x,d,w,scal,&
       rxyzParab, potentialPrefac, confPotOrder, work_conv)

!!  rmr_new=dot(ncplx*(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f),d(1),1,d(1),1)
!!  write(*,*)'debug1',rmr_new

  !this operation should be rewritten in a better way
  !r=b-d ! r=b-Ax
  ! Rewritten using axpy since precondition_preconditioner is now called with r instead of b
  call axpy(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f, -1.d0, d(1), 1, r(1), 1)

!!$  call calculate_rmr_new(lr%geocode,lr%hybrid_on,ncplx,lr%wfd,scal,r,d,rmr_new)
  call calculate_rmr_new(lr%mesh,lr%hybrid_on,ncplx,lr%wfd,scal,r,d,rmr_new)
  !stands for
  !d=r
  !rmr_new=dot_product(r,r)


  do icong=1,ncong 
     !write(*,*)icong,rmr_new
     call differentiateBetweenBoundaryConditions(ncplx,lr,hx,hy,hz,kx,ky,kz,cprecr,d,b,w,scal,&
          rxyzParab, potentialPrefac, confPotOrder, work_conv)

     !in the complex case these objects are to be supposed real
     ! 0/0 here!
     alpha=rmr_new/dot(ncplx*(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f),d(1),1,b(1),1)

     call axpy(ncplx*(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f),alpha,d(1),1,x(1),1)
     call axpy(ncplx*(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f),-alpha,b(1),1,r(1),1)

     if (icong==ncong) exit

     rmr_old=rmr_new

!!$     call calculate_rmr_new(lr%geocode,lr%hybrid_on,ncplx,lr%wfd,scal,r,b,rmr_new)
     call calculate_rmr_new(lr%mesh,lr%hybrid_on,ncplx,lr%wfd,scal,r,b,rmr_new)

     beta=rmr_new/rmr_old

     !d=b+beta*d
     call swap(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f, b(1), 1, d(1), 1)
     call axpy(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f, beta, b(1), 1, d(1), 1)
    
  enddo

!!$  call finalise_precond_residue(lr%geocode,lr%hybrid_on,ncplx,lr%wfd,scal,x)
  call finalise_precond_residue(lr%mesh,lr%hybrid_on,ncplx,lr%wfd,scal,x)

  !!call deallocate_workarrays_quartic_convolutions(work_conv)

  call f_free(b)
  call f_free(r)
  call f_free(d)

  !call timing(iproc,'deallocprec','ON') ! lr408t
  !call deallocate_work_arrays(lr%geocode,lr%hybrid_on,ncplx,w)
  !call timing(iproc,'deallocprec','OF') ! lr408t

  call f_release_routine()

END SUBROUTINE solvePrecondEquation


subroutine differentiateBetweenBoundaryConditions(ncplx,lr,hx,hy,hz,kx,ky,kz,&
     cprecr,x,y,w,scal, rxyzParab, parabPrefac, confPotOrder, work_conv)! y:=Ax
  use liborbs_precisions
  use locregs
  use locreg_operations
  use at_domain, only: domain_geocode
  use dynamic_memory
  implicit none
  integer, intent(in) :: ncplx
  real(gp), intent(in) :: hx,hy,hz,cprecr,kx,ky,kz
  type(locreg_descriptors), intent(in) :: lr
  real(gp), dimension(0:7), intent(in) :: scal
  real(wp), dimension(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f,ncplx), intent(in) ::  x
  type(workarr_precond), intent(inout) :: w
  real(wp), dimension(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f,ncplx), intent(out) ::  y
  real(8),dimension(3),intent(in):: rxyzParab
  real(8):: parabPrefac
  integer:: confPotOrder
  type(workarrays_quartic_convolutions),intent(inout):: work_conv
  !local variables
  integer :: idx,nf

  call f_routine(id='differentiateBetweenBoundaryConditions')

!!$  if (lr%geocode == 'F') then
  if (domain_geocode(lr%mesh%dom) == 'F') then
     do idx=1,ncplx
        call applyOperator(lr%d%n1,lr%d%n2,lr%d%n3,&
             lr%d%nfl1,lr%d%nfu1,lr%d%nfl2,lr%d%nfu2,lr%d%nfl3,lr%d%nfu3, lr%ns1, lr%ns2, lr%ns3, &
             lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%keygloc,lr%wfd%keyvloc,&
             lr%wfd%nseg_f,lr%wfd%nvctr_f,&
             lr%wfd%keygloc(1,lr%wfd%nseg_c+min(1,lr%wfd%nseg_f)),&
             lr%wfd%keyvloc(lr%wfd%nseg_c+min(1,lr%wfd%nseg_f)), &
             scal,cprecr,hx,hy,hz,&
             lr%bounds%kb%ibyz_c,lr%bounds%kb%ibxz_c,lr%bounds%kb%ibxy_c,&
             lr%bounds%kb%ibyz_f,lr%bounds%kb%ibxz_f,lr%bounds%kb%ibxy_f,&
             x(1,idx),x(lr%wfd%nvctr_c+min(1,lr%wfd%nvctr_f),idx),&
             y(1,idx),y(lr%wfd%nvctr_c+min(1,lr%wfd%nvctr_f),idx),&
             rxyzParab, parabPrefac, confPotOrder,work_conv)
     end do
!!$  else if (lr%geocode == 'P') then
  else if (domain_geocode(lr%mesh%dom) == 'P') then
     if (lr%hybrid_on) then

        nf=(lr%d%nfu1-lr%d%nfl1+1)*(lr%d%nfu2-lr%d%nfl2+1)*(lr%d%nfu3-lr%d%nfl3+1)
        do idx=1,ncplx
           call apply_hp_hyb(lr%d%n1,lr%d%n2,lr%d%n3,&
                lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%nseg_f,lr%wfd%nvctr_f,&
                lr%wfd%keygloc,lr%wfd%keyvloc, &
                cprecr,hx,hy,hz,x(1,idx),y(1,idx),&
                w%x_f,w%x_c,w%x_f1,w%x_f2,w%x_f3,w%y_f,w%z1,&
                lr%d%nfl1,lr%d%nfl2,lr%d%nfl3,lr%d%nfu1,lr%d%nfu2,lr%d%nfu3,nf,&
                lr%bounds%kb%ibyz_f,lr%bounds%kb%ibxz_f,lr%bounds%kb%ibxy_f)
        end do
     else
        if (ncplx == 1) then
           call apply_hp_scal(lr%d%n1,lr%d%n2,lr%d%n3,&
                lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%nseg_f,&
                lr%wfd%nvctr_f,lr%wfd%keygloc,lr%wfd%keyvloc, &
                cprecr,hx,hy,hz,x,y,w%psifscf,w%ww,w%modul1,w%modul2,w%modul3,&
                w%af,w%bf,w%cf,w%ef,scal) 
        else
           call apply_hp_per_k(lr%d%n1,lr%d%n2,lr%d%n3,&
                lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%nseg_f,&
                lr%wfd%nvctr_f,lr%wfd%keygloc,lr%wfd%keyvloc, &
                !cprecr,hx,hy,hz,0.0_gp,0.0_gp,0.0_gp,x,y,w%psifscf,w%ww,scal) 
                cprecr,hx,hy,hz,kx,ky,kz,x,y,w%psifscf,w%ww,scal) 
        end if
     end if
!!$  else if (lr%geocode == 'S') then
  else if (domain_geocode(lr%mesh%dom) == 'S') then
     if (ncplx == 1) then
        call apply_hp_slab_sd(lr%d%n1,lr%d%n2,lr%d%n3,&
             lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%nseg_f,&
             lr%wfd%nvctr_f,lr%wfd%keygloc,lr%wfd%keyvloc, &
             cprecr,x,y,w%psifscf,w%ww,w%modul1,w%modul3,&
             w%af,w%bf,w%cf,w%ef)
     else
        call apply_hp_slab_k(lr%d%n1,lr%d%n2,lr%d%n3,&
             lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%nseg_f,&
             lr%wfd%nvctr_f,lr%wfd%keygloc,lr%wfd%keyvloc, &
             cprecr,hx,hy,hz,kx,ky,kz,x,y,w%psifscf,w%ww) 

     end if
  else if (domain_geocode(lr%mesh%dom) == 'W') then
     if (ncplx == 1) then
        call apply_hp_wire_sd(lr%d%n1,lr%d%n2,lr%d%n3,&
             lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%nseg_f,&
             lr%wfd%nvctr_f,lr%wfd%keygloc,lr%wfd%keyvloc, &
             cprecr,x,y,w%psifscf,w%ww,w%modul3,&
             w%af,w%bf,w%cf,w%ef)
     else
        call apply_hp_wire_k(lr%d%n1,lr%d%n2,lr%d%n3,&
             lr%wfd%nseg_c,lr%wfd%nvctr_c,lr%wfd%nseg_f,&
             lr%wfd%nvctr_f,lr%wfd%keygloc,lr%wfd%keyvloc, &
             cprecr,hx,hy,hz,kx,ky,kz,x,y,w%psifscf,w%ww) 

     end if
  end if

  call f_release_routine()

END SUBROUTINE differentiateBetweenBoundaryConditions
