!> @file
!!  Routines to handle projectors
!! @author
!!    Copyright (C) 2010-2015 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

!> Returns the compressed form of a Gaussian projector
!! @f$ x^lx * y^ly * z^lz * exp (-1/(2*gau_a^2) *((x-rx)^2 + (y-ry)^2 + (z-rz)^2 )) @f$
!! in the array proj.
subroutine crtproj(geocode,ns1,ns2,ns3,n1,n2,n3, &
     hx,hy,hz,kx,ky,kz,ncplx_k,g,rx,ry,rz, &
     mvctr_c,mvctr_f,mseg_c,mseg_f,keyv_p,keyg_p,proj,wpr,gau_cut)
  use module_precisions
  use module_bigdft_arrays
  use module_bigdft_profiling
  use module_bigdft_errors
  use wrapper_linalg
  use locreg_operations, only: workarrays_projectors,NCPLX_MAX
  use at_domain, only: bc_periodic_dims,geocode_to_bc
  use gaussians
  use f_arrays
  implicit none
  character(len=1), intent(in) :: geocode !< @copydoc poisson_solver::doc::geocode
  integer, intent(in) :: mvctr_c,mvctr_f,mseg_c,mseg_f
  integer, intent(in) :: ncplx_k,ns1,ns2,ns3,n1,n2,n3
  real(gp), intent(in) :: hx,hy,hz,rx,ry,rz,kx,ky,kz
  real(gp), intent(in) :: gau_cut

  type(gaussian_real_space), intent(in) :: g

  integer, dimension(mseg_c+mseg_f), intent(in) :: keyv_p
  integer, dimension(2,mseg_c+mseg_f), intent(in) :: keyg_p
  type(workarrays_projectors),intent(inout) :: wpr
  real(wp), dimension((mvctr_c+7*mvctr_f)*ncplx_k), intent(out) :: proj
  !Local variables
  character(len=*), parameter :: subname='crtproj'
  logical :: perx,pery,perz !variables controlling the periodicity in x,y,z
  integer :: iterm,n_gau,ml1,ml2,ml3,mu1,mu2,mu3,i1,i2,i3
  integer :: ncplx_w,n1p1,np,i0jj
  integer :: j1,i0,j0,jj,ii,i,iseg,ind_f,ind_c
  integer :: mvctr1, mvctr2, mvctr_cf, mvctr_cf2, iskip
  logical, dimension(3) :: peri
  integer, dimension(3) :: iper
  !integer :: counter !test
  !real(wp) :: re_cmplx_prod,im_cmplx_prod
  type(f_scalar) :: one
  !real(gp) :: err_norm
  !real(wp), allocatable, dimension(:,:,:) :: work
  real(wp) :: wprojyz, wprojyz11, wprojyz12, wprojyz21, wprojyz22
  !Variables for OpenMP
  !!$ integer :: ithread,nthread,ichunk
  !!$ integer :: omp_get_thread_num,omp_get_num_threads

!!  integer :: ncount0,ncount_rate,ncount_max,ncount1,ncount2


  !call initialize_real_space_conversion() !initialize the work arrays needed to integrate with isf

  call f_routine(id='crtproj')

  ! rename region boundaries
  n1p1=n1+1
  np=n1p1*(n2+1)
  mvctr_cf=mvctr_c+7*mvctr_f
  mvctr_cf2=2*mvctr_c+7*mvctr_f

  !wproj is complex for PAW and kpoints.
  ncplx_w=max(ncplx_k,1)
  if (imag(g%sigma) /= 0._gp) ncplx_w=2

  ! The workarrays wpr%wprojx, wpr%wprojy, wpr%wprojz are allocated with the
  ! first dimension equala to NCPLX_MAX (which is 2). However the routine gauss_to_daub_k always
  ! assumes the correct value for ncplx_w and thus fills the arrays
  ! contiguously. Therefore in the non-complex case one has to fill the holes in
  ! thw workarrays.
  if (ncplx_w==NCPLX_MAX) then
      iskip = 1
  else
      iskip = 2
  end if

  ! Check the dimensions
  if (size(wpr%wprojx,2)<n1) call f_err_throw('workarray wpr%wprojx too small',err_name='BIGDFT_RUNTIME_ERROR')
  if (size(wpr%wprojy,2)<n2) call f_err_throw('workarray wpr%wprojy too small',err_name='BIGDFT_RUNTIME_ERROR')
  if (size(wpr%wprojz,2)<n3) call f_err_throw('workarray wpr%wprojz too small',err_name='BIGDFT_RUNTIME_ERROR')

  !if(ncplx_wproj==2 .or. nterm>1) proj=0.d0 !initialize to zero in this cases

!  allocate(work(0:nw,2,2+ndebug),stat=i_stat)  !always use complex value
!  call memocc(i_stat,work,'work',subname)

  !check that the number of elements of the projector is coherent
  mvctr1=0
  do iseg=1,mseg_c
     mvctr1=mvctr1+keyg_p(2,iseg)-keyg_p(1,iseg)+1
  end do
  mvctr2=0
  do iseg=mseg_c+1,mseg_c+mseg_f
     mvctr2=mvctr2+keyg_p(2,iseg)-keyg_p(1,iseg)+1
  end do

  if (mvctr1 /=  mvctr_c) then
     write(*,'(1x,a,i0,1x,i0)')' ERROR (crtproj 1): mvctr /= mvctr_c ',mvctr1,mvctr_c
     stop
  end if

  if (mvctr2 /= mvctr_f) then
     write(*,'(1x,a,i0,1x,i0)')' ERROR (crtproj 1): mvctr /= mvctr_f ',mvctr2,mvctr_f
     stop
  end if

  !REALLY SLOW ON VESTA, TEMPORARY CHANGE ONLY
  !!wprojx = f_malloc((/ 1.to.ncplx_w, 0.to.n1, 1.to.2, 1.to.nterm /),id='wprojx')
  !!wprojy = f_malloc((/ 1.to.ncplx_w, 0.to.n2, 1.to.2, 1.to.nterm /),id='wprojy')
  !!wprojz = f_malloc((/ 1.to.ncplx_w, 0.to.n3, 1.to.2, 1.to.nterm /),id='wprojz')

  !!if (size(wpr%wprojx)<size(wprojx)) stop 'size x'
  !!if (size(wpr%wprojy)<size(wprojy)) stop 'size y'
  !!if (size(wpr%wprojz)<size(wprojz)) stop 'size z'
  !!if (size(wpr%wprojx,1)/=size(wprojx,1)) stop 'ncplx not equal'
  !!if (size(wpr%wprojx,2)/=size(wprojx,2)) stop 'n1 not equal'
  !allocate(wprojx(1:ncplx_w,0:n1,1:2,1:nterm))
  !allocate(wprojy(1:ncplx_w,0:n2,1:2,1:nterm))
  !allocate(wprojz(1:ncplx_w,0:n3,1:2,1:nterm))

  !conditions for periodicity in the three directions
!!$  perx=(geocode /= 'F')
!!$  pery=(geocode == 'P')
!!$  perz=(geocode /= 'F')
  iper=geocode_to_bc(geocode)
  peri=bc_periodic_dims(iper)
  perx=peri(1)
  pery=peri(2)
  perz=peri(3)

  one = f_scalar(1._gp, 0._gp)

  ! make sure that the coefficients returned by CALL GAUSS_TO_DAUB are zero outside [ml:mr]
  !n(c) err_norm=0.0_gp

!!  call system_clock(ncount0,ncount_rate,ncount_max)

  ! OpenMP commented here as doesn't work on Vesta
  !!$omp parallel default(shared) private(iterm,work,ml1,mu1,ml2,mu2,ml3,mu3) &
  !!$omp private(ithread,ichunk,factor,n_gau)

  !!$omp critical
    !#work = f_malloc((/ 0.to.nw, 1.to.2, 1.to.2 /),id='work')
  !allocate(work(0:nw,1:2,1:2))
  !!$omp end critical

  !!wprojx=0.d0
  !!wpr%wprojx=0.d0

  !!$ ithread=omp_get_thread_num()
  !!$ nthread=omp_get_num_threads()
  !!$ ichunk=0
  do iterm=1,g%nterms
     !!$ ichunk=ichunk+1
     !!$ if (mod(ichunk,nthread).eq.ithread) then
     n_gau=g%lxyz(1, iterm)
     !!call gauss_to_daub_k(hx,kx*hx,ncplx_w,ncplx_g,ncplx_k,factor,rx,gau_a,n_gau,ns1,n1,ml1,mu1,&
     !!     wprojx(1,0,1,iterm),wpr%work,nw,perx,gau_cut)
     call gauss_to_daub_k(hx,kx*hx,ncplx_w,ncplx_k,g%factors(iterm),rx,g%sigma,n_gau,ns1,n1,ml1,mu1,&
          wpr%wproj(1),wpr%work,size(wpr%work, 1),perx,gau_cut)
     !!$ endif
     call vcopy(ncplx_w*(n1+1), wpr%wproj(1), 1, wpr%wprojx(1,0,1,iterm), iskip)
     call vcopy(ncplx_w*(n1+1), wpr%wproj(ncplx_w*(n1+1)+1), 1, wpr%wprojx(1,0,2,iterm), iskip)

     !!$ ichunk=ichunk+1
     !!$ if (mod(ichunk,nthread).eq.ithread) then
     n_gau=g%lxyz(2, iterm)
     call gauss_to_daub_k(hy,ky*hy,ncplx_w,ncplx_k,one,ry,g%sigma,n_gau,ns2,n2,ml2,mu2,&
          wpr%wproj(1),wpr%work,size(wpr%work, 1),pery,gau_cut)
     !!$ endif
     call vcopy(ncplx_w*(n2+1), wpr%wproj(1), 1, wpr%wprojy(1,0,1,iterm), iskip)
     call vcopy(ncplx_w*(n2+1), wpr%wproj(ncplx_w*(n2+1)+1), 1, wpr%wprojy(1,0,2,iterm), iskip)

     !!$ ichunk=ichunk+1
     !!$ if (mod(ichunk,nthread).eq.ithread) then
     n_gau=g%lxyz(3, iterm)
     call gauss_to_daub_k(hz,kz*hz,ncplx_w,ncplx_k,one,rz,g%sigma,n_gau,ns3,n3,ml3,mu3,&
          wpr%wproj(1),wpr%work,size(wpr%work, 1),perz,gau_cut)
     !!$ endif
     call vcopy(ncplx_w*(n3+1), wpr%wproj(1), 1, wpr%wprojz(1,0,1,iterm), iskip)
     call vcopy(ncplx_w*(n3+1), wpr%wproj(ncplx_w*(n3+1)+1), 1, wpr%wprojz(1,0,2,iterm), iskip)
  end do

  !!$omp critical
    !#call f_free(work)
  !deallocate(work)
  !!$omp end critical
  !!$omp end parallel

  !write(10000+bigdft_mpi%iproc*10,*) wpr%wprojx
  !!write(10000+bigdft_mpi%iproc*10+1,*) wprojx

!wprojx=wpr%wprojx
!wprojy=wpr%wprojy
!wprojz=wpr%wprojz

  !the filling of the projector should be different if ncplx==1 or 2
  !split such as to avoid intensive call to if statements
!!  call system_clock(ncount1,ncount_rate,ncount_max)
!!  write(20,*) 'TIMING1:', dble(ncount1-ncount0)/dble(ncount_rate)

  if (ncplx_w==1) then
     !$omp parallel default(private) shared(mseg_c,keyv_p,keyg_p,n3,n2) &
     !$omp shared(n1,proj,wpr,mvctr_c) &
     !$omp shared(mvctr_f,mseg_f,g,n1p1,np)
     ! coarse part
     !$omp do
     do iseg=1,mseg_c
        jj=keyv_p(iseg)
        j0=keyg_p(1,iseg)
        j1=keyg_p(2,iseg)
        ii=j0-1
        i3=ii/np
        ii=ii-i3*np
        i2=ii/n1p1
        i0=ii-i2*n1p1
        i1=i0+j1-j0
        i0jj=jj-i0
        wprojyz=wpr%wprojy(1,i2,1,1)*wpr%wprojz(1,i3,1,1)
        do i=i0,i1
           ind_c=i+i0jj
           proj(ind_c)=&
                wpr%wprojx(1,i,1,1)*wprojyz
  !!write(20000+bigdft_mpi%iproc*10,*) wpr%wprojx(1,i,1,1)
  !!write(20000+bigdft_mpi%iproc*10+1,*) wpr%wpr%wprojx(1,i,1,1)
        enddo
     enddo
     !$omp enddo

     ! First term: fine projector components
     ! fine part (beware of the behaviour with loop of zero size!)
     !$omp do
     do iseg=mseg_c+1,mseg_c+mseg_f
        jj=keyv_p(iseg)
        j0=keyg_p(1,iseg)
        j1=keyg_p(2,iseg)
        ii=j0-1
        i3=ii/(np)
        ii=ii-i3*np
        i2=ii/n1p1
        i0=ii-i2*n1p1
        i1=i0+j1-j0
        i0jj=7*(jj-i0-1)+mvctr_c
        wprojyz11=wpr%wprojy(1,i2,1,1)*wpr%wprojz(1,i3,1,1)
        wprojyz21=wpr%wprojy(1,i2,2,1)*wpr%wprojz(1,i3,1,1)
        wprojyz12=wpr%wprojy(1,i2,1,1)*wpr%wprojz(1,i3,2,1)
        wprojyz22=wpr%wprojy(1,i2,2,1)*wpr%wprojz(1,i3,2,1)
        do i=i0,i1
           ind_f=7*i+i0jj
           proj(ind_f+1)=wpr%wprojx(1,i,2,1)*wprojyz11
           proj(ind_f+2)=wpr%wprojx(1,i,1,1)*wprojyz21
           proj(ind_f+3)=wpr%wprojx(1,i,2,1)*wprojyz21
           proj(ind_f+4)=wpr%wprojx(1,i,1,1)*wprojyz12
           proj(ind_f+5)=wpr%wprojx(1,i,2,1)*wprojyz12
           proj(ind_f+6)=wpr%wprojx(1,i,1,1)*wprojyz22
           proj(ind_f+7)=wpr%wprojx(1,i,2,1)*wprojyz22
  !!write(30000+bigdft_mpi%iproc*10,*) wpr%wprojx(1,i,2,1)
  !!write(30000+bigdft_mpi%iproc*10+1,*) wpr%wpr%wprojx(1,i,2,1)
        enddo
     enddo
     !$omp enddo

     if (g%nterms >= 2) then
        ! Other terms: coarse projector components
        ! coarse part
        !$omp do
        do iseg=1,mseg_c
           jj=keyv_p(iseg)
           j0=keyg_p(1,iseg)
           j1=keyg_p(2,iseg)
           ii=j0-1
           i3=ii/(np)
           ii=ii-i3*np
           i2=ii/n1p1
           i0=ii-i2*n1p1
           i1=i0+j1-j0
           i0jj=jj-i0
           do i=i0,i1
              ind_c=i+i0jj
              do iterm=2,g%nterms
                 proj(ind_c)=proj(ind_c)+&
                      wpr%wprojx(1,i,1,iterm)*wpr%wprojy(1,i2,1,iterm)*wpr%wprojz(1,i3,1,iterm)
  !!write(40000+bigdft_mpi%iproc*10,*) wpr%wprojx(1,i,1,iterm)
  !!write(40000+bigdft_mpi%iproc*10+1,*) wpr%wpr%wprojx(1,i,1,iterm)
              end do
           end do
        end do
        !$omp enddo

        ! Other terms: fine projector components
        !$omp do
        do iseg=mseg_c+1,mseg_c+mseg_f
           jj=keyv_p(iseg)
           j0=keyg_p(1,iseg)
           j1=keyg_p(2,iseg)
           ii=j0-1
           i3=ii/(np)
           ii=ii-i3*np
           i2=ii/n1p1
           i0=ii-i2*n1p1
           i1=i0+j1-j0
           i0jj=7*(jj-i0-1)+mvctr_c
           do i=i0,i1
              ind_f=7*i+i0jj
              do iterm=2,g%nterms
                 proj(ind_f+1)=proj(ind_f+1)+&
                      wpr%wprojx(1,i,2,iterm)*wpr%wprojy(1,i2,1,iterm)*wpr%wprojz(1,i3,1,iterm)
                 proj(ind_f+2)=proj(ind_f+2)+&
                      wpr%wprojx(1,i,1,iterm)*wpr%wprojy(1,i2,2,iterm)*wpr%wprojz(1,i3,1,iterm)
                 proj(ind_f+3)=proj(ind_f+3)+&
                      wpr%wprojx(1,i,2,iterm)*wpr%wprojy(1,i2,2,iterm)*wpr%wprojz(1,i3,1,iterm)
                 proj(ind_f+4)=proj(ind_f+4)+&
                      wpr%wprojx(1,i,1,iterm)*wpr%wprojy(1,i2,1,iterm)*wpr%wprojz(1,i3,2,iterm)
                 proj(ind_f+5)=proj(ind_f+5)+&
                      wpr%wprojx(1,i,2,iterm)*wpr%wprojy(1,i2,1,iterm)*wpr%wprojz(1,i3,2,iterm)
                 proj(ind_f+6)=proj(ind_f+6)+&
                      wpr%wprojx(1,i,1,iterm)*wpr%wprojy(1,i2,2,iterm)*wpr%wprojz(1,i3,2,iterm)
                 proj(ind_f+7)=proj(ind_f+7)+&
                      wpr%wprojx(1,i,2,iterm)*wpr%wprojy(1,i2,2,iterm)*wpr%wprojz(1,i3,2,iterm)
  !!write(50000+bigdft_mpi%iproc*10,*) wpr%wprojx(1,i,2,iterm)
  !!write(50000+bigdft_mpi%iproc*10+1,*) wpr%wpr%wprojx(1,i,2,iterm)
                 !! proj_f(1,i-i0+jj)=proj_f(1,i-i0+jj)+&
                 !!      wpr%wprojx(i,2,iterm)*wpr%wprojy(i2,1,iterm)*wpr%wprojz(i3,1,iterm)
                 !! proj_f(2,i-i0+jj)=proj_f(2,i-i0+jj)+&
                 !!      wpr%wprojx(i,1,iterm)*wpr%wprojy(i2,2,iterm)*wpr%wprojz(i3,1,iterm)
                 !! proj_f(3,i-i0+jj)=proj_f(3,i-i0+jj)+&
                 !!      wpr%wprojx(i,2,iterm)*wpr%wprojy(i2,2,iterm)*wpr%wprojz(i3,1,iterm)
                 !! proj_f(4,i-i0+jj)=proj_f(4,i-i0+jj)+&
                 !!      wpr%wprojx(i,1,iterm)*wpr%wprojy(i2,1,iterm)*wpr%wprojz(i3,2,iterm)
                 !! proj_f(5,i-i0+jj)=proj_f(5,i-i0+jj)+&
                 !!      wpr%wprojx(i,2,iterm)*wpr%wprojy(i2,1,iterm)*wpr%wprojz(i3,2,iterm)
                 !! proj_f(6,i-i0+jj)=proj_f(6,i-i0+jj)+&
                 !!      wpr%wprojx(i,1,iterm)*wpr%wprojy(i2,2,iterm)*wpr%wprojz(i3,2,iterm)
                 !! proj_f(7,i-i0+jj)=proj_f(7,i-i0+jj)+&
                 !!      wpr%wprojx(i,2,iterm)*wpr%wprojy(i2,2,iterm)*wpr%wprojz(i3,2,iterm)
              end do
           end do
        end do
        !$omp enddo
     end if
     !$omp end parallel

  else if (ncplx_w==2) then
     !$omp parallel default(private) shared(mseg_c,keyv_p,keyg_p,n3,n2,ncplx_k) &
     !$omp shared(n1,proj,wpr,mvctr_c) &
     !$omp shared(g,mvctr_f,mseg_f,n1p1,np,mvctr_cf,mvctr_cf2)
     !part with real and imaginary part
     !modify the openMP statements such as to benefit from parallelisation
     !Here accumulate only the REAL part,
     !The imaginary part is done below

     ! coarse part
     !$omp do
     do iseg=1,mseg_c
        jj=keyv_p(iseg)
        j0=keyg_p(1,iseg)
        j1=keyg_p(2,iseg)
        ii=j0-1
        i3=ii/(np)
        ii=ii-i3*np
        i2=ii/n1p1
        i0=ii-i2*n1p1
        i1=i0+j1-j0
        i0jj=jj-i0
        do i=i0,i1
           ind_c=i+i0jj
           proj(ind_c)=&
                re_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,1,1))
        enddo
     enddo
     !$omp end do

     ! First term: fine projector components
     ! fine part
     !$omp do
     do iseg=mseg_c+1,mseg_c+mseg_f
        jj=keyv_p(iseg)
        j0=keyg_p(1,iseg)
        j1=keyg_p(2,iseg)
        ii=j0-1
        i3=ii/(np)
        ii=ii-i3*np
        i2=ii/n1p1
        i0=ii-i2*n1p1
        i1=i0+j1-j0
        i0jj=7*(jj-i0-1)+mvctr_c
        do i=i0,i1
           ind_f=7*i+i0jj
           proj(ind_f+1)=re_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,1,1))
           proj(ind_f+2)=re_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,1,1))
           proj(ind_f+3)=re_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,1,1))
           proj(ind_f+4)=re_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,2,1))
           proj(ind_f+5)=re_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,2,1))
           proj(ind_f+6)=re_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,2,1))
           proj(ind_f+7)=re_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,2,1))
        enddo
     enddo
     !$omp end do

     if (g%nterms >= 2) then
        ! Other terms: coarse projector components
        ! coarse part
        !$omp do
        do iseg=1,mseg_c
           jj=keyv_p(iseg)
           j0=keyg_p(1,iseg)
           j1=keyg_p(2,iseg)
           ii=j0-1
           i3=ii/(np)
           ii=ii-i3*np
           i2=ii/n1p1
           i0=ii-i2*n1p1
           i1=i0+j1-j0
           i0jj=jj-i0
           do i=i0,i1
              ind_c=i+i0jj
              do iterm=2,g%nterms
                 proj(ind_c)=proj(ind_c)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,1,iterm))
              end do
           end do
        end do
        !$omp enddo

        ! Other terms: fine projector components
        !$omp do
        do iseg=mseg_c+1,mseg_c+mseg_f
           jj=keyv_p(iseg)
           j0=keyg_p(1,iseg)
           j1=keyg_p(2,iseg)
           ii=j0-1
           i3=ii/(np)
           ii=ii-i3*np
           i2=ii/n1p1
           i0=ii-i2*n1p1
           i1=i0+j1-j0
           i0jj=7*(jj-i0-1)+mvctr_c
           do i=i0,i1
              ind_f=7*i+i0jj
              do iterm=2,g%nterms
                 proj(ind_f+1)=proj(ind_f+1)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,1,iterm))
                 proj(ind_f+2)=proj(ind_f+2)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,1,iterm))
                 proj(ind_f+3)=proj(ind_f+3)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,1,iterm))
                 proj(ind_f+4)=proj(ind_f+4)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,2,iterm))
                 proj(ind_f+5)=proj(ind_f+5)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,2,iterm))
                 proj(ind_f+6)=proj(ind_f+6)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,2,iterm))
                 proj(ind_f+7)=proj(ind_f+7)+re_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,2,iterm))
              end do
           end do
        end do
        !$omp enddo
     end if

     if(ncplx_k==2) then
        !now the imaginary part, only for complex projectors
        !when ncplx_g==2 and ncplx_k==1 the projectors are real.
        !so we skip this part.


     !$omp do
     do iseg=1,mseg_c
        jj=keyv_p(iseg)
        j0=keyg_p(1,iseg)
        j1=keyg_p(2,iseg)
        ii=j0-1
        i3=ii/(np)
        ii=ii-i3*np
        i2=ii/n1p1
        i0=ii-i2*n1p1
        i1=i0+j1-j0
        i0jj=jj-i0+mvctr_cf
        do i=i0,i1
           ind_c=i+i0jj
           proj(ind_c)=&
                im_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,1,1))
        enddo
     enddo
     !$omp enddo

     ! First term: fine projector components
     ! fine part
     !$omp do
     do iseg=mseg_c+1,mseg_c+mseg_f
        jj=keyv_p(iseg)
        j0=keyg_p(1,iseg)
        j1=keyg_p(2,iseg)
        ii=j0-1
        i3=ii/(np)
        ii=ii-i3*np
        i2=ii/n1p1
        i0=ii-i2*n1p1
        i1=i0+j1-j0
        !correction for xlf compiler bug
        ind_f=mvctr_cf2+7*(jj-2)
        do i=i0,i1
           ind_f=ind_f+7
           !ind_f=mvctr_c+7*mvctr_f+mvctr_c+7*(i-i0+jj-1)
           proj(ind_f+1)=im_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,1,1))
           proj(ind_f+2)=im_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,1,1))
           proj(ind_f+3)=im_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,1,1))
           proj(ind_f+4)=im_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,2,1))
           proj(ind_f+5)=im_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,1,1),wpr%wprojz(1:2,i3,2,1))
           proj(ind_f+6)=im_cmplx_prod(wpr%wprojx(1:2,i,1,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,2,1))
           proj(ind_f+7)=im_cmplx_prod(wpr%wprojx(1:2,i,2,1),wpr%wprojy(1:2,i2,2,1),wpr%wprojz(1:2,i3,2,1))
        enddo
     enddo
     !$omp enddo

     if (g%nterms >= 2) then
        ! Other terms: coarse projector components
        ! coarse part
        !$omp do
        do iseg=1,mseg_c
           jj=keyv_p(iseg)
           j0=keyg_p(1,iseg)
           j1=keyg_p(2,iseg)
           ii=j0-1
           i3=ii/(np)
           ii=ii-i3*np
           i2=ii/n1p1
           i0=ii-i2*n1p1
           i1=i0+j1-j0
           i0jj=jj-i0+mvctr_cf
           do i=i0,i1
              ind_c=i+i0jj
              do iterm=2,g%nterms
                 proj(ind_c)=proj(ind_c)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,1,iterm))
              end do
           end do
        end do
        !$omp enddo

        ! Other terms: fine projector components
        !$omp do
        do iseg=mseg_c+1,mseg_c+mseg_f
           jj=keyv_p(iseg)
           j0=keyg_p(1,iseg)
           j1=keyg_p(2,iseg)
           ii=j0-1
           i3=ii/(np)
           ii=ii-i3*np
           i2=ii/n1p1
           i0=ii-i2*n1p1
           i1=i0+j1-j0
           i0jj=7*(jj-i0-1)+mvctr_cf2
           do i=i0,i1
              ind_f=7*i+i0jj
              do iterm=2,g%nterms
                 proj(ind_f+1)=proj(ind_f+1)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,1,iterm))
                 proj(ind_f+2)=proj(ind_f+2)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,1,iterm))
                 proj(ind_f+3)=proj(ind_f+3)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,1,iterm))
                 proj(ind_f+4)=proj(ind_f+4)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,2,iterm))
                 proj(ind_f+5)=proj(ind_f+5)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,1,iterm),wpr%wprojz(1:2,i3,2,iterm))
                 proj(ind_f+6)=proj(ind_f+6)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,1,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,2,iterm))
                 proj(ind_f+7)=proj(ind_f+7)+im_cmplx_prod(&
                      wpr%wprojx(1:2,i,2,iterm),wpr%wprojy(1:2,i2,2,iterm),wpr%wprojz(1:2,i3,2,iterm))
              end do
           end do
        end do
        !$omp enddo
     end if  !nterm >= 2
     end if  !ncplx_k==2
     !$omp end parallel

  end if !ncplx_w==2
!!  call system_clock(ncount2,ncount_rate,ncount_max)
!!  write(20,*) 'TIMING2:', dble(ncount2-ncount1)/dble(ncount_rate)

  !!call f_free(wprojx)
  !!call f_free(wprojy)
  !!call f_free(wprojz)
  !deallocate(wprojx)
  !deallocate(wprojy)
  !deallocate(wprojz)

!  i_all=-product(shape(work))*kind(work)
!  deallocate(work,stat=i_stat)
!  call memocc(i_stat,i_all,'work',subname)
  !call finalize_real_space_conversion()

  call f_release_routine()

contains

  !> Real part of the complex product
  pure function re_cmplx_prod(a,b,c)
    use module_precisions
    implicit none
    real(wp), dimension(2), intent(in) :: a,b,c
    real(wp) :: re_cmplx_prod

    re_cmplx_prod=a(1)*(b(1)*c(1)-b(2)*c(2)) &
         -a(2)*(b(1)*c(2)+b(2)*c(1))


  END FUNCTION re_cmplx_prod


  !>   Imaginary part of the complex product
  pure function im_cmplx_prod(a,b,c)
    use module_precisions
    implicit none
    real(wp), dimension(2), intent(in) :: a,b,c
    real(wp) :: im_cmplx_prod

    im_cmplx_prod=a(2)*(b(1)*c(1)-b(2)*c(2)) &
         +a(1)*(b(2)*c(1)+b(1)*c(2))

  END FUNCTION im_cmplx_prod

END SUBROUTINE crtproj

subroutine plr_segs_and_vctrs(plr,nseg_c,nseg_f,nvctr_c,nvctr_f)
  use locregs
  implicit none
  type(locreg_descriptors), intent(in) :: plr
  integer, intent(out) :: nseg_c,nseg_f,nvctr_c,nvctr_f
  !local variables

  nseg_c=plr%wfd%nseg_c
  nseg_f=plr%wfd%nseg_f
  nvctr_c=plr%wfd%nvctr_c
  nvctr_f=plr%wfd%nvctr_f

end subroutine plr_segs_and_vctrs
