!>   Extract the pseudopotential basis
!! @warning
!!   This is not the complete PSP basis set. 
!!   The radial power term is lacking in the gaussian descriptors should be added if needed
subroutine gaussian_psp_basis(at,rxyz,G)
  use module_base
  use module_types
  implicit none
  type(atoms_data), intent(in) :: at
  real(gp), dimension(3,at%astruct%nat), target, intent(in) :: rxyz
  type(gaussian_basis), intent(out) :: G  
  !local variables
  character(len=*), parameter :: subname='gaussian_psp_basis'
  integer :: iat,nshell,ityp,iexpo,l,ishell

  G%nat=at%astruct%nat
  G%rxyz => rxyz
  G%nshell = f_malloc_ptr(at%astruct%nat,id='G%nshell')
 
  G%nshltot=0
  do iat=1,G%nat
     ityp=at%astruct%iatype(iat) 
     nshell=0
     do l=1,4 
        if (at%psppar(l,0,ityp) /= 0.0_gp) nshell=nshell+1
     enddo
     G%nshell(iat)=nshell
     G%nshltot=G%nshltot+nshell
  end do

  G%ndoc = f_malloc_ptr(G%nshltot,id='G%ndoc')
  G%nam = f_malloc_ptr(G%nshltot,id='G%nam')

  !assign shell IDs and count the number of exponents and coefficients
  G%ncplx=1
  G%nexpo=0
  G%ncoeff=0
  ishell=0
  do iat=1,G%nat
     ityp=at%astruct%iatype(iat)
     do l=1,4 
        if (at%psppar(l,0,ityp) /= 0.0_gp) then
           ishell=ishell+1
           G%ndoc(ishell)=1
           G%nam(ishell)=l
           G%nexpo=G%nexpo+1
           G%ncoeff=G%ncoeff+2*l-1
        end if
     enddo
  end do

  !allocate and assign the exponents and the coefficients
  G%xp = f_malloc_ptr((/ G%ncplx, G%nexpo /),id='G%xp')
  G%psiat = f_malloc_ptr((/ G%ncplx, G%nexpo /),id='G%psiat')

  ishell=0
  iexpo=0
  do iat=1,G%nat
     ityp=at%astruct%iatype(iat)
     do l=1,4 
        if (at%psppar(l,0,ityp) /= 0.0_gp) then
           ishell=ishell+1
           iexpo=iexpo+1
           G%psiat(1,iexpo)=1.0_gp
           G%xp(1,iexpo)=at%psppar(l,0,ityp)
        end if
     end do
  end do

END SUBROUTINE gaussian_psp_basis



!>
!!
!!
subroutine gaussian_orthogonality(iproc,nproc,norb,norbp,G,coeffs)
  use module_base
  use module_types
  use gaussians
  implicit none
  integer, intent(in) :: iproc,nproc,norb,norbp
  type(gaussian_basis), intent(in) :: G
  real(wp), dimension(G%ncoeff,norbp), intent(inout) :: coeffs
  !local variables
  character(len=*), parameter :: subname='gaussian_orthogonality' 
  integer :: iorb,i,jproc,info,ierr
  integer, dimension(:,:), allocatable :: gatherarr
  real(gp), dimension(:,:), allocatable :: ovrlp,gaupsi,tmp,smat

  ovrlp = f_malloc((/ G%ncoeff, G%ncoeff /),id='ovrlp')
  gaupsi = f_malloc((/ G%ncoeff, norb /),id='gaupsi')
  tmp = f_malloc((/ G%ncoeff, norb /),id='tmp')
  smat = f_malloc((/ norb, norb /),id='smat')


  if (nproc > 1) then
     gatherarr = f_malloc((/ 0.to.nproc-1, 1.to.2 /),id='gatherarr')

     !gather the coefficients in a unique array
     do jproc=0,nproc-1
        gatherarr(jproc,1)=G%ncoeff*min(max(norb-jproc*norbp,0),norbp)
        gatherarr(jproc,2)=G%ncoeff*min(jproc*norbp,norb)
     end do

     call MPI_ALLGATHERV(coeffs,gatherarr(iproc,1),mpidtypw,gaupsi,gatherarr(0,1),gatherarr(0,2),&
          mpidtypw,bigdft_mpi%mpi_comm,ierr)

     call f_free(gatherarr)
  else
     gaupsi(1:G%ncoeff,1:norb)=coeffs(1:G%ncoeff,1:norb)
  end if

  !overlap of the basis
  call gaussian_overlap(G,G,ovrlp)

  call dsymm('L','U',G%ncoeff,norb,1.0_gp,ovrlp(1,1),G%ncoeff,gaupsi(1,1),G%ncoeff,&
       0.0_gp,tmp(1,1),G%ncoeff)

  call gemm('T','N',norb,norb,G%ncoeff,1.0_gp,gaupsi(1,1),G%ncoeff,tmp(1,1),G%ncoeff,&
       0.0_wp,smat(1,1),norb)
  !print overlap matrices
  if (iproc==0) then
     do i=1,norb
        write(*,'(a,i3,i3,30(1pe19.12))')'ovrlp',iproc,i,(smat(i,iorb),iorb=1,norb)
     end do
  end if

  !orthogonalise the overlap matrix (from orthon_p)
  ! Cholesky factorization
  call potrf( 'L',norb,smat(1,1),norb,info)
  if (info.ne.0) write(6,*) 'info Cholesky factorization',info

  ! calculate L^{-1}
  call trtri( 'L','N',norb,smat(1,1),norb,info)
  if (info.ne.0) write(6,*) 'info L^-1',info

  ! new vectors   
  call trmm('R','L','T','N',G%ncoeff,norb,1.0_wp,smat(1,1),norb,gaupsi(1,1),G%ncoeff)

  !copy the result in the portion of the array
  do iorb=1,norbp
     if (iorb+iproc*norbp <= norb) then
        do i=1,G%ncoeff
           coeffs(i,iorb)=gaupsi(i,iorb+iproc*norbp)
        end do
     end if
  end do
  
  call f_free(ovrlp)
  call f_free(tmp)
  call f_free(smat)
  call f_free(gaupsi)

END SUBROUTINE gaussian_orthogonality




!>   Calculates @f$\int_0^\infty \exp^{-a*x^2} x^l dx@f$
!!
!!
function gauinth(a,l)
  use module_base
  implicit none
  integer, intent(in) :: l
  real(gp), intent(in) :: a
  real(gp) :: gauinth
  !local variables
  real(gp), parameter :: gammaonehalf=1.772453850905516027298_gp
  integer :: p
  real(gp) :: xfac,prefac,tt,sh
  !build the prefactor
  prefac=sqrt(a)
  prefac=1.d0/prefac
  prefac=prefac**(l+1)
  p=1-l+2*(l/2)
  tt=0.5d0*gammaonehalf**p
  prefac=prefac*tt
  sh=-0.5d0*real(p,gp)
  p=l/2
  tt=xfac(1,p,sh)

  !final result
  gauinth=prefac*tt
  
END FUNCTION gauinth


!>
!!
!!
function rfac(is,ie)
  use module_base
  implicit none
  integer, intent(in) :: is,ie
  real(gp) :: rfac
  !local variables
  integer :: i
  real(gp) :: tt
  rfac=1.d0
  do i=is,ie
     tt=real(i,gp)
     rfac=rfac*tt
  end do
END FUNCTION rfac



!>   With this function n!=xfac(1,n,0.d0)
!!
!!
function xfac(is,ie,sh)
  use module_base
  implicit none
  integer, intent(in) :: is,ie
  real(gp), intent(in) :: sh
  real(gp) :: xfac
  !local variables
  integer :: i
  real(gp) :: tt
  xfac=1.d0
  do i=is,ie
     tt=real(i,gp)+sh
     xfac=xfac*tt
  end do
END FUNCTION xfac



!End of the interesting part
!!$
!!$
!!$!>   The same function but with integer factorials (valid ONLY if l<=18)
!!$!!   not a visible improvement in speed with respect to the analogous real
!!$!!
!!$!!
!!$function gauinti(a,c,l)
!!$  use module_base
!!$  implicit none
!!$  integer, intent(in) :: l
!!$  real(gp), intent(in) :: a,c
!!$  real(gp) :: gauinti
!!$  !local variables
!!$  real(gp), parameter :: gammaonehalf=1.772453850905516027298d0
!!$  integer :: p,ifac
!!$  real(gp) :: prefac,xsum,stot,fsum,tt,firstprod
!!$  !build the prefactor
!!$  prefac=sqrt(a)
!!$  prefac=c**l/prefac
!!$  prefac=gammaonehalf*prefac
!!$
!!$  !object in the sum
!!$  xsum=a*c**2
!!$  xsum=1.d0/xsum
!!$
!!$  !the first term of the sum is one
!!$  stot=1.d0
!!$
!!$  !calculate the sum
!!$  do p=1,l/4
!!$     tt=real(ifac(p+1,2*p),gp)
!!$     fsum=real(ifac(l-2*p+1,l),gp)
!!$     fsum=fsum/tt
!!$     tt=firstprod(p)
!!$     fsum=fsum*tt
!!$     fsum=fsum*xsum**p
!!$     stot=stot+fsum
!!$  end do
!!$  do p=l/4+1,l/3
!!$     tt=real(ifac(p+1,l-2*p),gp)
!!$     fsum=real(ifac(2*p+1,l),gp)
!!$     fsum=fsum/tt
!!$     tt=firstprod(p)
!!$     fsum=fsum*tt
!!$     fsum=fsum*xsum**p
!!$     stot=stot+fsum
!!$  end do
!!$  do p=l/3+1,l/2
!!$     tt=real(ifac(l-2*p+1,p),gp)
!!$     fsum=real(ifac(2*p+1,l),gp)
!!$     fsum=fsum*tt
!!$     tt=firstprod(p)
!!$     fsum=fsum*tt
!!$     fsum=fsum*xsum**p
!!$     stot=stot+fsum
!!$  end do
!!$
!!$  !final result
!!$  gauinti=stot*prefac
!!$  
!!$END FUNCTION gauinti
!!$
!!$
!!$
!!$!>   Valid if p<l/4 AND p/=0
!!$!!
!!$!!
!!$function secondprod1(p,l)
!!$  use module_base
!!$  implicit none
!!$  integer, intent(in) :: p,l
!!$  real(gp) :: secondprod1
!!$  !local variables
!!$  !integer :: i
!!$  real(gp) :: tt,part1,rfac
!!$  part1=rfac(p+1,2*p)
!!$  !divide by the last value
!!$  part1=real(l,gp)/part1
!!$  tt=rfac(l-2*p+1,l-1)
!!$!!!  part1=1.d0
!!$!!!  do i=p+1,2*p !in the second case the bound must be changed here
!!$!!!     tt=real(i,gp)
!!$!!!     part1=part1*tt
!!$!!!  end do
!!$  secondprod1=tt*part1
!!$END FUNCTION secondprod1
!!$
!!$
!!$
!!$!>   Valid if p>=l/4 AND p<l/3
!!$!!
!!$!!
!!$function secondprod2(p,l)
!!$  use module_base
!!$  implicit none
!!$  integer, intent(in) :: p,l
!!$  real(gp) :: secondprod2
!!$  !local variables
!!$  !integer :: i
!!$  real(gp) :: tt,part1,rfac
!!$  part1=rfac(p+1,l-2*p)
!!$  !divide by the last value
!!$  part1=real(l,gp)/part1
!!$  tt=rfac(2*p+1,l-1)
!!$!!!  part1=1.d0
!!$!!!  do i=p+1,2*p !in the second case the bound must be changed here
!!$!!!     tt=real(i,gp)
!!$!!!     part1=part1*tt
!!$!!!  end do
!!$  secondprod2=tt*part1
!!$END FUNCTION secondprod2
!!$
!!$
!!$
!!$!>   Integer version of factorial
!!$!!
!!$!!
!!$function ifac(is,ie)
!!$  implicit none
!!$  integer, intent(in) :: is,ie
!!$  integer :: ifac
!!$  !local variables
!!$  integer :: i
!!$  ifac=1
!!$  do i=is,ie
!!$     ifac=ifac*i
!!$  end do
!!$END FUNCTION ifac
!!$
