!> Reformat one wavefunction
subroutine reformatonewave(displ,wfd,nat,dom,hx_old,hy_old,hz_old,n1_old,n2_old,n3_old,& !n(c) iproc (arg:1)
     rxyz_old,psigold,hx,hy,hz,n1,n2,n3,rxyz,psifscf,psi)
  use liborbs_precisions
  use box
  use at_domain
  use bounds, only: ext_buffers_coarse
  use compression
  use numerics, only: onehalf,pi
  use dynamic_memory
  use wrapper_linalg
  use f_utils
  implicit none
  integer, intent(in) :: n1_old,n2_old,n3_old,n1,n2,n3,nat  !n(c) iproc
  real(gp), intent(in) :: hx,hy,hz,displ,hx_old,hy_old,hz_old
  type(wavefunctions_descriptors), intent(in) :: wfd
  type(domain), intent(in) :: dom
  real(gp), dimension(3,nat), intent(in) :: rxyz_old,rxyz
  real(wp), dimension(0:n1_old,2,0:n2_old,2,0:n3_old,2), intent(in) :: psigold
  real(wp), dimension(wfd%nvctr_c+7*wfd%nvctr_f), intent(out) :: psi
  real(wp), dimension(*), intent(out) :: psifscf !this supports different BC
  !local variables
  character(len=*), parameter :: subname='reformatonewave'
  logical :: cif1,cif2,cif3,perx,pery,perz
  integer :: i1,i2,i3,j1,j2,j3,l1,l2,iat,nb1,nb2,nb3,ind,jj1,jj2,jj3a,jj3b,jj3c
  integer :: ind2,ind3,n1nb1,n2nb2,n1o7,n2o7,n3o7,n1nb1o,n2nb2o,n3nb3o
  real(gp) :: hxh,hyh,hzh,hxh_old,hyh_old,hzh_old,x,y,z,dx,dy,dz,xold,yold,zold!,mindist
  real(wp) :: zr,yr,xr,ym1,y00,yp1
  real(wp), dimension(-1:1,-1:1) :: xya
  real(wp), dimension(-1:1) :: xa
  real(wp), dimension(:), allocatable :: ww,wwold
  real(wp), dimension(:,:,:,:,:,:), allocatable :: psig
  real(wp), dimension(:,:,:), allocatable :: psifscfold
  real(gp), dimension(3) :: rd
  !type(cell) :: mesh
  !type(domain) :: dom
  logical, dimension(3) :: peri
  !real(kind=4) :: t0, t1
  !real(kind=8) :: time

  call f_routine(id='reformatonewave')


  !mesh=cell_new(at%astruct%geocode,[n1,n2,n3],[hx,hy,hz])
  !dom=domain_new(units=ATOMIC_UNITS,bc=geocode_to_bc_enum(at%astruct%geocode),&
  !          alpha_bc=onehalf*pi,beta_ac=onehalf*pi,gamma_ab=onehalf*pi,acell=[n1,n2,n3]*[hx,hy,hz])
  !mesh=cell_new(dom,[n1,n2,n3],[hx,hy,hz])
!  mesh=cell_new(dom,ndims,hgrids)![n1,n2,n3],[hx,hy,hz])

  !conditions for periodicity in the three directions
!!$  perx=(at%astruct%geocode /= 'F')
!!$  pery=(at%astruct%geocode == 'P')
!!$  perz=(at%astruct%geocode /= 'F')
  peri=domain_periodic_dims(dom)
  perx=peri(1)
  pery=peri(2)
  perz=peri(3)

  !buffers related to periodicity
  !WARNING: the boundary conditions are not assumed to change between new and old
  call ext_buffers_coarse(perx,nb1)
  call ext_buffers_coarse(pery,nb2)
  call ext_buffers_coarse(perz,nb3)

  psifscfold = f_malloc((/ -nb1.to.2*n1_old+1+nb1, -nb2.to.2*n2_old+1+nb2, -nb3.to.2*n3_old+1+nb3 /),id='psifscfold')
  wwold = f_malloc((2*n1_old+2+2*nb1)*(2*n2_old+2+2*nb2)*(2*n3_old+2+2*nb3),id='wwold')

  if (domain_geocode(dom)=='F') then
     call synthese_grow(n1_old,n2_old,n3_old,wwold,psigold,psifscfold)
  else if (domain_geocode(dom) =='S') then
     call synthese_slab(n1_old,n2_old,n3_old,wwold,psigold,psifscfold)
  else if (domain_geocode(dom) =='P') then
     call synthese_per(n1_old,n2_old,n3_old,wwold,psigold,psifscfold)
  else if (domain_geocode(dom) =='W') then
     call synthese_wire(n1_old,n2_old,n3_old,wwold,psigold,psifscfold)
  end if

  call f_free(wwold)

  !write(*,*) iproc,' displ ',displ
  if (hx == hx_old .and. hy == hy_old .and. hz == hz_old .and. &
       n1_old==n1 .and. n2_old==n2 .and. n3_old==n3 .and. &
       displ<= 1.d-2) then
     !if (iproc==0) write(*,*) iproc,' orbital just copied'
     call vcopy((2*n1+2+2*nb1)*(2*n2+2+2*nb2)*(2*n3+2+2*nb3),psifscfold(-nb1,-nb2,-nb3),1,&
          psifscf(1),1)
!!$     do i3=-nb3,2*n3+1+nb3
!!$        do i2=-nb2,2*n2+1+nb2
!!$           do i1=-nb1,2*n1+1+nb1
!!$              ind=i1+nb1+1+(2*n1+2+2*nb1)*(i2+nb2)+&
!!$                   (2*n1+2+2*nb1)*(2*n2+2+2*nb2)*(i3+nb3)
!!$              psifscf(ind)=psifscfold(i1,i2,i3)
!!$           enddo
!!$        enddo
!!$     enddo

  else

    rd=0.0_gp
     do iat=1,nat
       rd=rd+closest_r(dom,rxyz(:,iat),center=rxyz_old(:,iat))
     end do
     rd=rd/real(nat,gp)
     dx=rd(1)
     dy=rd(2)
     dz=rd(3)
!!$     dx=0.0_gp
!!$     dy=0.0_gp
!!$     dz=0.0_gp
!!$     !Calculate average shift
!!$     !Take into account the modulo operation which should be done for non-isolated BC
!!$     do iat=1,nat
!!$        dx=dx+mindist(perx,at%astruct%cell_dim(1),rxyz(1,iat),rxyz_old(1,iat))
!!$        dy=dy+mindist(pery,at%astruct%cell_dim(2),rxyz(2,iat),rxyz_old(2,iat))
!!$        dz=dz+mindist(perz,at%astruct%cell_dim(3),rxyz(3,iat),rxyz_old(3,iat))
!!$     enddo
!!$     dx=dx/real(nat,gp)
!!$     dy=dy/real(nat,gp)
!!$     dz=dz/real(nat,gp)

     ! transform to new structure
     !if (iproc==0) write(*,*) iproc,' orbital fully transformed'
     hxh=.5_gp*hx
     hxh_old=.5_gp*hx_old
     hyh=.5_gp*hy
     hyh_old=.5_gp*hy_old
     hzh=.5_gp*hz
     hzh_old=.5_gp*hz_old

     call f_zero((2*n1+2+2*nb1)*(2*n2+2+2*nb2)*(2*n3+2+2*nb3),psifscf(1))
     !call cpu_time(t0)

     n1nb1=(2*n1+2+2*nb1)
     n2nb2=(2*n2+2+2*nb2)
     n1nb1o=2*n1_old+1+2*nb1+1
     n2nb2o=2*n2_old+1+2*nb2+1
     n3nb3o=2*n3_old+1+2*nb3+1
     n1o7=2*n1_old+7
     n2o7=2*n2_old+7
     n3o7=2*n3_old+7

     !$omp parallel do default(none) &
     !$omp shared(nb1,nb2,nb3,n1,n2,n3,hxh,hyh,hzh,hxh_old,hyh_old,hzh_old,dx,dy,dz,perx,pery,perz) &
     !$omp shared(n1o7,n2o7,n3o7,n1nb1o,n2nb2o,n3nb3o,n1nb1,n2nb2,psifscf,psifscfold) &
     !$omp private(i1,i2,i3,j1,j2,j3,x,y,z,xold,yold,zold,cif1,cif2,cif3,ind,ind2,ind3,xr,yr,zr) &
     !$omp private(l1,l2,jj1,jj2,jj3a,jj3b,jj3c,ym1,y00,yp1,xya,xa)
     do i3=-nb3,2*n3+1+nb3
        z=real(i3,gp)*hzh
        zold=z-dz
        j3=nint(zold/hzh_old)
        cif3=(j3 >= -6 .and. j3 <= n3o7) .or. perz
        if (.not.cif3) cycle

        zr =real((zold-real(j3,gp)*hzh_old)/hzh_old,wp)
        jj3a=modulo(j3-1+nb3,n3nb3o)-nb3
        jj3b=modulo(j3  +nb3,n3nb3o)-nb3
        jj3c=modulo(j3+1+nb3,n3nb3o)-nb3
        ind3=n1nb1*n2nb2*(i3+nb3)+nb1+1
        do i2=-nb2,2*n2+1+nb2
           y=real(i2,gp)*hyh
           yold=y-dy

           j2=nint(yold/hyh_old)
           cif2=(j2 >= -6 .and. j2 <= n2o7) .or. pery
           if (.not. cif2) cycle

           yr = real((yold-real(j2,gp)*hyh_old)/hyh_old,wp)
           ind2=n1nb1*(i2+nb2)
           do i1=-nb1,2*n1+1+nb1
              x=real(i1,gp)*hxh
              xold=x-dx

              j1=nint(xold/hxh_old)
              cif1=(j1 >= -6 .and. j1 <= n1o7) .or. perx

              if (cif1) then
                 ind=i1+ind2+ind3
                 do l2=-1,1
                    jj2=modulo(j2+l2+nb2,n2nb2o)-nb2
                    do l1=-1,1
                       !the modulo has no effect on free BC thanks to the
                       !if statement above
                       jj1=modulo(j1+l1+nb1,n1nb1o)-nb1

                       ym1=psifscfold(jj1,jj2,jj3a)
                       y00=psifscfold(jj1,jj2,jj3b)
                       yp1=psifscfold(jj1,jj2,jj3c)

                       xya(l1,l2)=ym1 + &
                            (1.0_wp + zr)*(y00 - ym1 + zr*(.5_wp*ym1 - y00  + .5_wp*yp1))
                    enddo
                 enddo

                 do l1=-1,1
                    ym1=xya(l1,-1)
                    y00=xya(l1,0)
                    yp1=xya(l1,1)
                    xa(l1)=ym1 + &
                         (1.0_wp + yr)*(y00 - ym1 + yr*(.5_wp*ym1 - y00  + .5_wp*yp1))
                 enddo

                 xr = real((xold-real(j1,gp)*hxh_old)/hxh_old,wp)
                 ym1=xa(-1)
                 y00=xa(0)
                 yp1=xa(1)
                 psifscf(ind)=ym1 + &
                      (1.0_wp + xr)*(y00 - ym1 + xr*(.5_wp*ym1 - y00  + .5_wp*yp1))

              endif

           enddo
        enddo
     enddo
     !$omp end parallel do

     !call cpu_time(t1)
     !time=real(t1-t0,kind=8)
     !if (bigdft_mpi%iproc==0) print*,'time',time

  endif

  !write(100+iproc,*) 'norm of psifscf ',dnrm2((2*n1+16)*(2*n2+16)*(2*n3+16),psifscf,1)

  call f_free(psifscfold)

  psig = f_malloc((/ 0.to.n1, 1.to.2, 0.to.n2, 1.to.2, 0.to.n3, 1.to.2 /),id='psig')
  ww = f_malloc((2*n1+2+2*nb1)*(2*n2+2+2*nb2)*(2*n3+2+2*nb3),id='ww')

  select case(domain_geocode(dom))
  case('F')
    call analyse_shrink(n1,n2,n3,ww,psifscf,psig)
  case('S')
    call analyse_slab(n1,n2,n3,ww,psifscf,psig)
  case('P')
    call analyse_per(n1,n2,n3,ww,psifscf,psig)
  case('W')
    call analyse_wire(n1,n2,n3,ww,psifscf,psig)
  end select

  !write(100+iproc,*) 'norm new psig ',dnrm2(8*(n1+1)*(n2+1)*(n3+1),psig,1)
  call compress_plain(n1,n2,0,n1,0,n2,0,n3,  &
       wfd%nseg_c,wfd%nvctr_c,wfd%keygloc(1,1),wfd%keyvloc(1),   &
       wfd%nseg_f,wfd%nvctr_f,&
       wfd%keygloc(1,wfd%nseg_c+min(1,wfd%nseg_f)),&
       wfd%keyvloc(wfd%nseg_c+min(1,wfd%nseg_f)),   &
       psig,psi(1),psi(wfd%nvctr_c+min(1,wfd%nvctr_f)))

  !write(100+iproc,*) 'norm of reformatted psi ',dnrm2(nvctr_c+7*nvctr_f,psi,1)

  call f_free(psig)
  call f_free(ww)

  call f_release_routine()

END SUBROUTINE reformatonewave
