!> test program for the convolution library
program libconv
  use f_unittests
  use yaml_output
  implicit none

  call f_lib_initialize()
  
  call yaml_sequence_open("Testing various boundary conditions")
  call run(surf)
  call yaml_sequence_close()
  
  call f_lib_finalize()

contains
  subroutine surf(label)
    use f_precisions, only: f_double
    use at_domain
    implicit none
    character(len = *), intent(out) :: label

    real(f_double) :: mdiff

    label = "Surface"

    call expectFailure("To be reworked")

    call checkDiff(mdiff, 30, 80, 33, (/ PERIODIC_BC, FREE_BC, PERIODIC_BC /), &
         (/ 10._f_double, 80 * 0.333_f_double, 11._f_double /))
    call compare(mdiff, 0._f_double, "diff", tol = 1d-8)
  end subroutine surf

end program libconv

subroutine checkDiff(mdiff, n1, n2, n3, per, acell)
  use f_enums
  use f_precisions

  use box
  use f_functions
  use locregs
  use locreg_operations
  use numerics
  use at_domain
  use dynamic_memory
  use f_utils
  use yaml_output
  use compression
  implicit none
  integer, intent(in) :: n1, n2, n3
  type(f_enumerator), dimension(3), intent(in) :: per
  real(f_double), dimension(3), intent(in) :: acell
  real(f_double), intent(out) :: mdiff

  integer :: i
  real(f_double) :: ekin
  type(domain) :: dom
  type(box_iterator) :: bit
  type(locreg_descriptors) :: lr
  type(workarr_sumrho) :: w
  type(workarr_locham) :: wrk_lh
  logical, dimension(3) :: pers
  real(f_double), dimension(3) :: hgrids, kpoint
  real(f_double), dimension(6) :: k_strten
  type(f_function), dimension(3) :: funcs
  real(f_double), dimension(:), pointer :: psir,psi,tpsi,psir_work,tpsir
  logical(f_byte), dimension(:,:,:), allocatable :: logrid_c,logrid_f
  integer, dimension(2, 3) :: nbox
  
  hgrids=acell / (/ n1, n2, n3 /)
  kpoint=0._f_double

  dom = domain_new(ATOMIC_UNITS, per, acell = acell)
  nbox(1, :) = 0
  nbox(2, :) = (/ n1, n2, n3 /)
  call init_lr(lr,dom,0.5 * (/ acell(1) / n1, 1._f_double / 3._f_double, acell(3) / n3 /),&
       nbox,nbox,hybrid_flag = .true.)
  call box_iter_validate(lr%bit)

  logrid_c = f_malloc((/ 0.to.n1, 0.to.n2, 0.to.n3 /),id='logrid_c')
  logrid_f = f_malloc((/ 0.to.n1, 0.to.n2, 0.to.n3 /),id='logrid_f')

  logrid_c = .true.
  logrid_f = .true.
  call init_wfd_from_full_grids(lr%wfd, n1, n2, n3, logrid_c, logrid_f)

  call f_free(logrid_c)
  call f_free(logrid_f)
  
  pers=domain_periodic_dims(dom)
  do i=1,3
     if (pers(i)) then
        funcs(i)=f_function_new(f_exp_cosine,&
             length=acell(i),frequency=2.0_f_double)
     else
        funcs(i)=f_function_new(f_shrink_gaussian,&
             length=acell(i))
!!$        funcs(i)=f_function_new(f_gaussian,&
!!$             exponent=1.0_f_double/(10.0_f_double*mesh%hgrids(i)**2))
     end if
     !funcs(i)=f_function_new(f_constant,prefactor=11.0_f_double)
  end do

  psir=f_malloc_ptr(lr%mesh%ndim,id='psir',info='{alignment: 32}')
  tpsir=f_malloc_ptr(lr%mesh%ndim,id='tpsir',info='{alignment: 32}')

  psir_work=f_malloc_ptr(lr%mesh%ndim,id='psir_work',info='{alignment: 32}')
  psi=f_malloc_ptr(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f,id='psi',info='{alignment: 32}')
  tpsi=f_malloc_ptr(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f,id='tpsi',info='{alignment: 32}')

  call f_zero(psir_work)
  call f_zero(psi)
  call f_zero(tpsi)
  bit=box_iter(lr%mesh,centered=.true.)
  !take the reference functions
  call separable_3d_function(bit,funcs,1.0_f_double,psir)
  call separable_3d_laplacian(bit,funcs,-2.0_f_double,tpsir)

  !initalize workspaces
  call initialize_work_arrays_sumrho(lr,.true.,w)
  call initialize_work_arrays_locham(lr,1,.true.,wrk_lh)

  !from real space to wavelet
  call isf_to_daub(lr,w,psir,psi)
  

  !from wavelets to real space and fine scaling functions space
  call daub_to_isf_locham(1,lr,wrk_lh,psi,psir_work)

  !multiply by the potential (zero in this case)
  call f_zero(psir_work)

  !calculate results of the laplacian
  call isf_to_daub_kinetic_clone(lr%mesh%hgrids(1),lr%mesh%hgrids(2),lr%mesh%hgrids(3),&
       kpoint(1),kpoint(2),kpoint(3),1,lr,wrk_lh,&
       psir_work,tpsi,ekin,k_strten)
!  call isf_to_daub_kinetic(mesh%hgrids(1),mesh%hgrids(2),mesh%hgrids(3),&
!       kpoint(1),kpoint(2),kpoint(3),1,lr,wrk_lh,&
!       psir_work,tpsi,ekin,k_strten)

  !from wavelets to real space
  call daub_to_isf(lr,w,tpsi,psir_work)

  !free work arrays
  call deallocate_work_arrays_sumrho(w)
  call deallocate_work_arrays_locham(wrk_lh)
  call deallocate_locreg_descriptors(lr)

  !compare the results (tpsir with psir_work) 
  call f_diff(f_size(tpsir),tpsir,psir_work,mdiff)

  call f_free_ptr(psir)
  call f_free_ptr(tpsir)
  call f_free_ptr(psir_work)
  call f_free_ptr(psi)
  call f_free_ptr(tpsi)

!!$  !list of routines which have to be duplicated and modified
!!$  call convolut_kinetic_slab_T_k(2*lr%d%n1+1,2*lr%d%n2+15,2*lr%d%n3+1,&
!!$                    hgridh,w%x_c(1,idx),w%y_c(1,idx),ekino,kx,ky,kz)
!!$
!!$ ! compute the kinetic part and add  it to psi_out
!!$ ! the kinetic energy is calculated at the same time
!!$ call convolut_kinetic_slab_T(2*lr%d%n1+1,2*lr%d%n2+15,2*lr%d%n3+1,&
!!$      hgridh,w%x_c(1,idx),w%y_c(1,idx),ekino)
!!$
!!$ call convolut_kinetic_hyb_T(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,  &
!!$      hgridh,w%x_c(1,idx),w%x_f(1,idx),w%y_c(1,idx),w%y_f(1,idx),kstrteno,&
!!$      w%x_f1(1,idx),w%x_f2(1,idx),w%x_f3(1,idx),lr%bounds%kb%ibyz_f,&
!!$      lr%bounds%kb%ibxz_f,lr%bounds%kb%ibxy_f)
!!$
!!$ call convolut_kinetic_per_T_k(2*lr%d%n1+1,2*lr%d%n2+1,2*lr%d%n3+1,&
!!$      hgridh,w%x_c(1,idx),w%y_c(1,idx),kstrteno,kx,ky,kz)
!!$ 
!!$ call convolut_kinetic_per_t(2*lr%d%n1+1,2*lr%d%n2+1,2*lr%d%n3+1,&
!!$      hgridh,w%x_c(1,idx),w%y_c(1,idx),kstrteno)
  
end subroutine checkDiff

subroutine isf_to_daub_kinetic_clone(hx,hy,hz,kx,ky,kz,nspinor,lr,w,psir,hpsi,ekin,k_strten)
  use liborbs_precisions
  use locregs
  use locreg_operations
  use at_domain
  implicit none
  !include 'libconvf.h'
  integer, parameter :: SYM8_DWT = 1, SYM8_IMF = 2
  
  integer, intent(in) :: nspinor
  real(gp), intent(in) :: hx,hy,hz,kx,ky,kz
  type(locreg_descriptors), intent(in) :: lr
  type(workarr_locham), intent(inout) :: w
  real(wp), dimension(lr%d%n1i*lr%d%n2i*lr%d%n3i,nspinor), intent(inout) :: psir
  real(gp), intent(out) :: ekin
  real(wp), dimension(lr%wfd%nvctr_c+7*lr%wfd%nvctr_f,nspinor), intent(inout) :: hpsi
  real(wp), dimension(6) :: k_strten
  !Local variables
  logical :: usekpts
  integer :: idx,i,i_f,iseg_f,ipsif,isegf
  real(gp) :: ekino
  real(wp), dimension(0:3) :: scal
  integer, dimension(0:2) :: dimsin, dimsout, bc
!!$  integer :: cost
  real(gp), dimension(3) :: hgridh
  real(wp), dimension(6) :: kstrten,kstrteno


  !control whether the k points are to be used
  !real k-point different from Gamma still not implemented
  usekpts = kx**2+ky**2+kz**2 > 0.0_gp .or. nspinor == 2

  hgridh(1)=hx*.5_gp
  hgridh(2)=hy*.5_gp
  hgridh(3)=hz*.5_gp

  do i=0,3
     scal(i)=1.0_wp
  enddo

  !starting point for the fine degrees, to avoid boundary problems
  i_f=min(1,lr%wfd%nvctr_f)
  iseg_f=min(1,lr%wfd%nseg_f)
  ipsif=lr%wfd%nvctr_c+i_f
  isegf=lr%wfd%nseg_c+iseg_f

  !call MPI_COMM_RANK(bigdft_mpi%mpi_comm,iproc,ierr)
  ekin=0.0_gp

  kstrten=0.0_wp
  select case(domain_geocode(lr%mesh%dom))
  case('F')

     !here kpoints cannot be used (for the moment, to be activated for the 
     !localisation region scheme
     if (usekpts) stop 'K points not allowed for Free BC locham'

     do idx=1,nspinor

        call comb_shrink(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,&
             w%w1,w%w2,psir(1,idx),&
             lr%bounds%kb%ibxy_c,lr%bounds%sb%ibzzx_c,lr%bounds%sb%ibyyzz_c,&
             lr%bounds%sb%ibxy_ff,lr%bounds%sb%ibzzx_f,lr%bounds%sb%ibyyzz_f,&
             w%y_c(1,idx),w%y_f(1,idx))

        call ConvolkineticT(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,  &
             hx,hy,hz,&      !here the grid spacings are supposed to be equal.  SM: not any more
             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, &
             w%x_c(1,idx),w%x_f(1,idx),&
             w%y_c(1,idx),w%y_f(1,idx),ekino, &
             w%x_f1(1,idx),w%x_f2(1,idx),w%x_f3(1,idx),111)
        ekin=ekin+ekino

        !new compression routine in standard form
        call compress_and_accumulate_standard(lr%d,lr%wfd,&
             lr%wfd%keyvloc(1),lr%wfd%keyvloc(isegf),&
             lr%wfd%keygloc(1,1),lr%wfd%keygloc(1,isegf),&
             w%y_c(1,idx),w%y_f(1,idx),&
             hpsi(1,idx),hpsi(ipsif,idx))
!!$        call compress_forstandard(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%wfd%nseg_c,lr%wfd%nvctr_c,&
!!$             lr%wfd%keygloc(1,1),lr%wfd%keyv(1),&
!!$             lr%wfd%nseg_f,lr%wfd%nvctr_f,&
!!$             lr%wfd%keygloc(1,lr%wfd%nseg_c+iseg_f),lr%wfd%keyv(lr%wfd%nseg_c+iseg_f),   &
!!$             scal,w%y_c(1,idx),w%y_f(1,idx),hpsi(1,idx),hpsi(lr%wfd%nvctr_c+i_f,idx))

     end do

  case('S')

     if (usekpts) then
        !first calculate the proper arrays then transpose them before passing to the
        !proper routine
        do idx=1,nspinor
           call convolut_magic_t_slab_self(2*lr%d%n1+1,2*lr%d%n2+15,2*lr%d%n3+1,&
                psir(1,idx),w%y_c(1,idx))
        end do

        !Transposition of the work arrays (use psir as workspace)
        call transpose_for_kpoints(nspinor,2*lr%d%n1+2,2*lr%d%n2+31,2*lr%d%n3+2,&
             w%x_c,psir,.true.)
        call transpose_for_kpoints(nspinor,2*lr%d%n1+2,2*lr%d%n2+31,2*lr%d%n3+2,&
             w%y_c,psir,.true.)

        ! compute the kinetic part and add  it to psi_out
        ! the kinetic energy is calculated at the same time
        ! do this thing for both components of the spinors
        do idx=1,nspinor,2
           call convolut_kinetic_slab_T_k(2*lr%d%n1+1,2*lr%d%n2+15,2*lr%d%n3+1,&
                hgridh,w%x_c(1,idx),w%y_c(1,idx),ekino,kx,ky,kz)
           ekin=ekin+ekino        
        end do

        !re-Transposition of the work arrays (use psir as workspace)
        call transpose_for_kpoints(nspinor,2*lr%d%n1+2,2*lr%d%n2+31,2*lr%d%n3+2,&
             w%y_c,psir,.false.)

        do idx=1,nspinor
           !new compression routine in mixed form
!           call analyse_slab_self(lr%d%n1,lr%d%n2,lr%d%n3,&
!                w%y_c(1,idx),psir(1,idx))
              call switch_s0_for_libconv(0,2*lr%d%n1+2,-1,2*lr%d%n2+16,0,2*lr%d%n3+2,w%y_c,psir)
!!$              call d_s0s1_1d(SYM8_DWT,3,0,2*[lr%d%n1+1,lr%d%n2+8,lr%d%n3+1],0,&
!!$                   2*[lr%d%n1+1,lr%d%n2+8,lr%d%n3+1],&
!!$                   2*[lr%d%n1+1,lr%d%n2+8,lr%d%n3+1],1,&
!!$                   w%y_c(1,idx),psir(1,idx),&
!!$                   1.0_wp,0.0_wp)
!!$                   !shrink
!!$              call d_s0s1_1d(SYM8_DWT,3,1,2*[lr%d%n1+1,lr%d%n2+8,lr%d%n3+1],-1,&
!!$                   2*[lr%d%n1+1,lr%d%n2+8,lr%d%n3+1],&
!!$                   2*[lr%d%n1+1,lr%d%n2+1,lr%d%n3+1],1,&
!!$                   psir(1,idx),w%y_c(1,idx),&
!!$                   1.0_wp,0.0_wp)
!!$              call d_s0s1_1d(SYM8_DWT,3,2,2*[lr%d%n1+1,lr%d%n2+8,lr%d%n3+1],0,&
!!$                   2*[lr%d%n1+1,lr%d%n2+1,lr%d%n3+1],&
!!$                   2*[lr%d%n1+1,lr%d%n2+1,lr%d%n3+1],1,&
!!$                   w%y_c(1,idx),psir(1,idx),&
!!$                   1.0_wp,0.0_wp)
           call compress_and_accumulate_mixed(lr%d,lr%wfd,&
                lr%wfd%keyvloc(1),lr%wfd%keyvloc(isegf),&
                lr%wfd%keygloc(1,1),lr%wfd%keygloc(1,isegf),&
                psir(1,idx),hpsi(1,idx),hpsi(ipsif,idx))

!!$           call compress_slab(lr%d%n1,lr%d%n2,lr%d%n3,&
!!$                lr%wfd%nseg_c,lr%wfd%nvctr_c,&
!!$                lr%wfd%keygloc(1,1),lr%wfd%keyv(1),   & 
!!$                lr%wfd%nseg_f,lr%wfd%nvctr_f,&
!!$                lr%wfd%keygloc(1,lr%wfd%nseg_c+iseg_f),lr%wfd%keyv(lr%wfd%nseg_c+iseg_f),   & 
!!$                w%y_c(1,idx),hpsi(1,idx),hpsi(lr%wfd%nvctr_c+i_f,idx),psir(1,idx))
        end do

     else
        do idx=1,nspinor
!           call convolut_magic_t_slab_self(2*lr%d%n1+1,2*lr%d%n2+15,2*lr%d%n3+1,&
!                psir(1,idx),w%y_c(1,idx))

            bc=(/0,-1,0/)
            dimsin=(/2*lr%d%n1+2,2*lr%d%n2+31,2*lr%d%n3+2/)
            dimsout=dimsin
!!$            do i=0,2
!!$              call d_s0s0_1d_dims(SYM8_IMF,3,i,dimsin,bc(i), 1.0_wp, 1.0_wp,0.0_wp, dimsout)
!!$!              print*,i,'dims in ', dimsin
!!$!              print*,i,'dims out', dimsout
!!$
!!$            call d_s0s0_1d_cost(SYM8_IMF,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   1.0_wp, 1.0_wp,0.0_wp, cost)
!!$!            print *, "cost for call ",i,":", cost, " flops"
!!$            if(i/=1) then
!!$              call d_s0s0_1d(SYM8_IMF,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   psir(1,idx),w%y_c(1,idx),&
!!$                   1.0_wp, 1.0_wp,0.0_wp)
!!$            else
!!$              call d_s0s0_1d(SYM8_IMF,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   w%y_c(1,idx),psir(1,idx),&
!!$                   1.0_wp, 1.0_wp,0.0_wp)
!!$            endif
!!$            dimsin=dimsout
!!$          end do

           ! compute the kinetic part and add  it to psi_out
           ! the kinetic energy is calculated at the same time
           call convolut_kinetic_slab_T(2*lr%d%n1+1,2*lr%d%n2+15,2*lr%d%n3+1,&
                hgridh,w%x_c(1,idx),w%y_c(1,idx),ekino)
           ekin=ekin+ekino

           !new compression routine in mixed form
!           call analyse_slab_self(lr%d%n1,lr%d%n2,lr%d%n3,&
!                w%y_c(1,idx),psir(1,idx))
              call switch_s0_for_libconv(0,2*lr%d%n1+2,-1,2*lr%d%n2+16,0,2*lr%d%n3+2,w%y_c,psir)


              dimsin=dimsout
!!$              do i=0,2
!!$                call d_s0s1_1d_dims(SYM8_DWT,3,i,dimsin,bc(i), 1.0_wp,0.0_wp, dimsout)
!!$                print*,i,'dims in ', dimsin
!!$                print*,i,'dims out', dimsout
!!$
!!$                call d_s0s1_1d_cost(SYM8_DWT,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   1.0_wp,0.0_wp, cost)
!!$                print *, "cost for call ",i,":", cost, " flops"
!!$                if(i==1) then
!!$                  call d_s0s1_1d(SYM8_DWT,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   psir(1,idx),w%y_c(1,idx),&
!!$                   1.0_wp,0.0_wp)
!!$                else
!!$                  call d_s0s1_1d(SYM8_DWT,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   w%y_c(1,idx),psir(1,idx),&
!!$                   1.0_wp,0.0_wp)
!!$                endif
!!$                dimsin=dimsout
!!$             end do

           call compress_and_accumulate_mixed(lr%d,lr%wfd,&
                lr%wfd%keyvloc(1),lr%wfd%keyvloc(isegf),&
                lr%wfd%keygloc(1,1),lr%wfd%keygloc(1,isegf),&
                psir(1,idx),hpsi(1,idx),hpsi(ipsif,idx))

!!$           call compress_slab(lr%d%n1,lr%d%n2,lr%d%n3,&
!!$                lr%wfd%nseg_c,lr%wfd%nvctr_c,&
!!$                lr%wfd%keygloc(1,1),lr%wfd%keyv(1),   & 
!!$                lr%wfd%nseg_f,lr%wfd%nvctr_f,&
!!$                lr%wfd%keygloc(1,lr%wfd%nseg_c+iseg_f),lr%wfd%keyv(lr%wfd%nseg_c+iseg_f),   & 
!!$                w%y_c(1,idx),hpsi(1,idx),hpsi(lr%wfd%nvctr_c+i_f,idx),psir(1,idx))
        end do
     end if

  case('P')

     if (lr%hybrid_on) then

        !here kpoints cannot be used, such BC are used in general to mimic the Free BC
        if (usekpts) stop 'K points not allowed for hybrid BC locham'

        !here the grid spacing is not halved
        hgridh(1)=hx
        hgridh(2)=hy
        hgridh(3)=hz
        do idx=1,nspinor
           call comb_shrink_hyb(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,&
                w%w2,w%w1,psir(1,idx),w%y_c(1,idx),w%y_f(1,idx),lr%bounds%sb)

           call convolut_kinetic_hyb_T(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,  &
                hgridh,w%x_c(1,idx),w%x_f(1,idx),w%y_c(1,idx),w%y_f(1,idx),kstrteno,&
                w%x_f1(1,idx),w%x_f2(1,idx),w%x_f3(1,idx),lr%bounds%kb%ibyz_f,&
                lr%bounds%kb%ibxz_f,lr%bounds%kb%ibxy_f)
           kstrten=kstrten+kstrteno
           !ekin=ekin+ekino

           call compress_and_accumulate_standard(lr%d,lr%wfd,&
                lr%wfd%keyvloc(1),lr%wfd%keyvloc(isegf),&
                lr%wfd%keygloc(1,1),lr%wfd%keygloc(1,isegf),&
                w%y_c(1,idx),w%y_f(1,idx),hpsi(1,idx),hpsi(ipsif,idx))

!!$           call compress_per_f(lr%d%n1,lr%d%n2,lr%d%n3,&
!!$                lr%wfd%nseg_c,lr%wfd%nvctr_c,&
!!$                lr%wfd%keygloc(1,1),lr%wfd%keyv(1),& 
!!$                lr%wfd%nseg_f,lr%wfd%nvctr_f,&
!!$                lr%wfd%keygloc(1,lr%wfd%nseg_c+iseg_f),lr%wfd%keyv(lr%wfd%nseg_c+iseg_f), & 
!!$                w%y_c(1,idx),w%y_f(1,idx),hpsi(1,idx),hpsi(lr%wfd%nvctr_c+i_f,idx),&
!!$                lr%d%nfl1,lr%d%nfl2,lr%d%nfl3,lr%d%nfu1,lr%d%nfu2,lr%d%nfu3)
        end do
     else
        if (usekpts) then
           !first calculate the proper arrays then transpose them before passing to the
           !proper routine
           do idx=1,nspinor
              call convolut_magic_t_per_self(2*lr%d%n1+1,2*lr%d%n2+1,2*lr%d%n3+1,&
                   psir(1,idx),w%y_c(1,idx))
           end do

           !Transposition of the work arrays (use psir as workspace)
           call transpose_for_kpoints(nspinor,2*lr%d%n1+2,2*lr%d%n2+2,2*lr%d%n3+2,&
                w%x_c,psir,.true.)
           call transpose_for_kpoints(nspinor,2*lr%d%n1+2,2*lr%d%n2+2,2*lr%d%n3+2,&
                w%y_c,psir,.true.)


           ! compute the kinetic part and add  it to psi_out
           ! the kinetic energy is calculated at the same time
           do idx=1,nspinor,2
              !print *,'AAA',2*lr%d%n1+1,2*lr%d%n2+1,2*lr%d%n3+1,hgridh

              call convolut_kinetic_per_T_k(2*lr%d%n1+1,2*lr%d%n2+1,2*lr%d%n3+1,&
                   hgridh,w%x_c(1,idx),w%y_c(1,idx),kstrteno,kx,ky,kz)
              kstrten=kstrten+kstrteno
              !ekin=ekin+ekino
           end do

           !Transposition of the work arrays (use psir as workspace)
           call transpose_for_kpoints(nspinor,2*lr%d%n1+2,2*lr%d%n2+2,2*lr%d%n3+2,&
                w%y_c,psir,.false.)

           do idx=1,nspinor

              call analyse_per_self(lr%d%n1,lr%d%n2,lr%d%n3,&
                   w%y_c(1,idx),psir(1,idx))
              call compress_and_accumulate_mixed(lr%d,lr%wfd,&
                   lr%wfd%keyvloc(1),lr%wfd%keyvloc(isegf),&
                   lr%wfd%keygloc(1,1),lr%wfd%keygloc(1,isegf),&
                   psir(1,idx),hpsi(1,idx),hpsi(ipsif,idx))

!!$              call compress_per(lr%d%n1,lr%d%n2,lr%d%n3,&
!!$                   lr%wfd%nseg_c,lr%wfd%nvctr_c,&
!!$                   lr%wfd%keygloc(1,1),lr%wfd%keyv(1),& 
!!$                   lr%wfd%nseg_f,lr%wfd%nvctr_f,&
!!$                   lr%wfd%keygloc(1,lr%wfd%nseg_c+iseg_f),lr%wfd%keyv(lr%wfd%nseg_c+iseg_f),&
!!$                   w%y_c(1,idx),hpsi(1,idx),hpsi(lr%wfd%nvctr_c+i_f,idx),psir(1,idx))
           end do
        else
           !first calculate the proper arrays then transpose them before passing to the
           !proper routine
           do idx=1,nspinor
!!$              call convolut_magic_t_per_self(2*lr%d%n1+1,2*lr%d%n2+1,2*lr%d%n3+1,&
!!$                   psir(1,idx),w%y_c(1,idx))
            bc=(/0,0,0/)
            dimsin=(/2*lr%d%n1+2,2*lr%d%n2+2,2*lr%d%n3+2/)
            dimsout=dimsin
!!$            do i=0,2
!!$              call d_s0s0_1d_dims(SYM8_IMF,3,i,dimsin,bc(i), 1.0_wp, 1.0_wp,0.0_wp, dimsout)
!!$!              print*,i,'dims in ', dimsin
!!$!              print*,i,'dims out', dimsout
!!$
!!$            call d_s0s0_1d_cost(SYM8_IMF,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   1.0_wp, 1.0_wp,0.0_wp, cost)
!!$            print *, "cost for call ",i,":", cost, " flops"
!!$            if(i/=1) then
!!$              call d_s0s0_1d(SYM8_IMF,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   psir(1,idx),w%y_c(1,idx),&
!!$                   1.0_wp, 1.0_wp,0.0_wp)
!!$            else
!!$              call d_s0s0_1d(SYM8_IMF,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   w%y_c(1,idx),psir(1,idx),&
!!$                   1.0_wp, 1.0_wp,0.0_wp)
!!$            endif
!!$            dimsin=dimsout
!!$          end do

              ! compute the kinetic part and add  it to psi_out
              ! the kinetic energy is calculated at the same time
              call convolut_kinetic_per_t(2*lr%d%n1+1,2*lr%d%n2+1,2*lr%d%n3+1,&
                   hgridh,w%x_c(1,idx),w%y_c(1,idx),kstrteno)
              kstrten=kstrten+kstrteno

              call switch_s0_for_libconv(0,2*lr%d%n1+2,0,2*lr%d%n2+2,0,2*lr%d%n3+2,w%y_c,psir)
              
              
              dimsin=dimsout
!!$              do i=0,2
!!$                call d_s0s1_1d_dims(SYM8_DWT,3,i,dimsin,bc(i), 1.0_wp,0.0_wp, dimsout)
!!$                print*,i,'dims in ', dimsin
!!$                print*,i,'dims out', dimsout
!!$
!!$                call d_s0s1_1d_cost(SYM8_DWT,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   1.0_wp,0.0_wp, cost)
!!$                print *, "cost for call ",i,":", cost, " flops"
!!$                if(i==1) then
!!$                  call d_s0s1_1d(SYM8_DWT,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   psir(1,idx),w%y_c(1,idx),&
!!$                   1.0_wp,0.0_wp)
!!$                else
!!$                  call d_s0s1_1d(SYM8_DWT,3,i,dimsin,bc(i),&
!!$                   dimsin,&
!!$                   dimsout,1,&
!!$                   w%y_c(1,idx),psir(1,idx),&
!!$                   1.0_wp,0.0_wp)
!!$                endif
!!$                dimsin=dimsout
!!$             end do


!!$              call analyse_per_self(lr%d%n1,lr%d%n2,lr%d%n3,&
!!$                   w%y_c(1,idx),psir(1,idx))
              call compress_and_accumulate_mixed(lr%d,lr%wfd,&
                   lr%wfd%keyvloc(1),lr%wfd%keyvloc(isegf),&
                   lr%wfd%keygloc(1,1),lr%wfd%keygloc(1,isegf),&
                   psir(1,idx),hpsi(1,idx),hpsi(ipsif,idx))

!!$              call compress_per(lr%d%n1,lr%d%n2,lr%d%n3,&
!!$                   lr%wfd%nseg_c,lr%wfd%nvctr_c,&
!!$                   lr%wfd%keygloc(1,1),lr%wfd%keyv(1),& 
!!$                   lr%wfd%nseg_f,lr%wfd%nvctr_f,&
!!$                   lr%wfd%keygloc(1,lr%wfd%nseg_c+iseg_f),lr%wfd%keyv(lr%wfd%nseg_c+iseg_f),& 
!!$                   w%y_c(1,idx),hpsi(1,idx),hpsi(lr%wfd%nvctr_c+i_f,idx),psir(1,idx))
           end do
        end if

     end if
     ekin=ekin+kstrten(1)+kstrten(2)+kstrten(3)
     k_strten=kstrten 

  end select

END SUBROUTINE isf_to_daub_kinetic_clone

subroutine switch_s0_for_libconv(bc1,n1,bc2,n2,bc3,n3,x,y)
  use f_precisions, only: f_double
  use dynamic_memory, only: f_memcpy
  implicit none
  integer, intent(in) :: bc1,bc2,bc3
  integer, intent(in) :: n1,n2,n3
  real(f_double), dimension(n1,n2,n3), intent(inout) :: x
  real(f_double), dimension(n1,n2,n3), intent(inout) :: y
  !local variables
  integer :: i1,i2,i3

  do i3=1,n3
     do i2=1,n2
        do i1=1,n1
           y(i1,i2,i3)=x(merge(modulo(i1,n1)+1, i1, bc1 == 0),&
           merge(modulo(i2,n2)+1, i2, bc2 == 0),&
           merge(modulo(i3,n3)+1, i3, bc3 == 0))
        end do
     end do
  end do
  call f_memcpy(src=y,dest=x)

end subroutine switch_s0_for_libconv
