!> XFT Potential
!! -------------------
!!
!! V(r_{ij}) = B * exp(-\eta r_{ij}) / r_{ij}^n
!!           + Bx * exp(-\etax r_{ij}^{2})
!!           - \frac{C}{r_{ij}^6} * [1 - (sum_{k=0}^{6} \frac{(damp_dd*r_{ij})^k}{k!})*exp(-damp_dd*r_{ij})]
!!           - \frac{D}{r_{ij}^8} * [1 - (sum_{l=0}^{8} \frac{(damp_dq*r_{ij})^l}{l!})*exp(-damp_dq*r_{ij})]
!!
module MW_xft
#ifndef MW_SERIAL
   use MPI
#endif
   use MW_timers
   use MW_kinds, only: wp
   use MW_box, only: MW_box_t
   use MW_electrode, only: MW_electrode_t
   use MW_ion, only: MW_ion_t
   use MW_localwork, only: MW_localwork_t
   use MW_parallel, only: MW_COMM_WORLD
   use MW_molecule, only: MW_molecule_t
   implicit none
   private

   ! Public type
   ! -----------
   public :: MW_xft_t

   ! Public subroutines
   ! ------------------
   public :: define_type
   public :: copy_type
   public :: void_type
   public :: print_type
   public :: set_rcut
   public :: set_parameters
   public :: mixing_rule
   public :: melt_forces
   public :: stress_tensor_tail_correction
   public :: energy
   public :: melt_fix_molecule_forces
   public :: fix_molecule_energy

   ! Data structure to handle XFT potentials
!! V(r_{ij}) = B * exp(-\eta r_{ij}) / r_{ij}^n
!!           + Bx * exp(-\etax r_{ij}^{2})
!!           - \frac{C}{r_{ij}^6} * [1 - (sum_{k=0}^{6} \frac{(damp_dd*r_{ij})^k}{k!})*exp(-damp_dd*r_{ij})]
!!           - \frac{D}{r_{ij}^8} * [1 - (sum_{l=0}^{8} \frac{(damp_dq*r_{ij})^l}{l!})*exp(-damp_dq*r_{ij})]
   type MW_xft_t
      integer :: num_species = 0                            ! number of species
      real(wp) :: rcut = 0.0_wp                             ! cut-off parameter
      real(wp) :: rcutsq = 0.0_wp                           ! cut-off parameter squared
      real(wp), dimension(:,:), allocatable :: eta          ! (num_species,num_species) exponential factor
      real(wp), dimension(:,:), allocatable :: B            ! (num_species,num_species) exponential scaling factor
      real(wp), dimension(:,:), allocatable :: etax         ! (num_species,num_species) exponential factor
      real(wp), dimension(:,:), allocatable :: Bx           ! (num_species,num_species) exponential scaling factor
      integer,  dimension(:,:), allocatable :: n            ! (num_species,num_species) exponent for the repulsive wall 
      real(wp), dimension(:,:), allocatable :: C            ! (num_species,num_species) dipole-dipole van der Waals attractive term
      real(wp), dimension(:,:), allocatable :: D            ! (num_species,num_species) dipole-quadripole van de Waals attractive termp
      real(wp), dimension(:,:), allocatable :: damp_dd      ! (num_species,num_species) dipole-dipole damping factor
      real(wp), dimension(:,:), allocatable :: damp_dq      ! (num_species,num_species) dipole-quadripole damping factor
      logical :: xft_3D_tail_correction = .false.           ! Flag to turn on the dispersion terms tail correction in 3D
   end type MW_xft_t

contains

   !================================================================================
   ! Define the data structure
   subroutine define_type(this, num_species, rcut)
      use MW_errors, only: &
            MW_errors_allocate_error => allocate_error, &
            MW_errors_parameter_error => parameter_error
      implicit none
      ! Parameters
      ! ---------_
      type(MW_xft_t), intent(inout) :: this      !> structure to be defined
      integer, intent(in) :: num_species                    !> number of species
      real(wp), intent(in) :: rcut

      ! Local
      ! -----
      integer :: ierr

      call set_rcut(this, rcut)

      if (num_species <= 0) then
         call MW_errors_parameter_error("define_type", "xft.f90",&
               "num_species", num_species)
      end if

      this%num_species = num_species

      allocate(this%eta(num_species,num_species), &
            this%B(num_species,num_species), &
            this%n(num_species,num_species), &
            this%etax(num_species,num_species), &
            this%Bx(num_species,num_species), &
            this%C(num_species,num_species), &
            this%D(num_species,num_species), &
            this%damp_dd(num_species,num_species), &
            this%damp_dq(num_species,num_species), stat=ierr)
      if (ierr /= 0) &
            call MW_errors_allocate_error("define_type", "xft.f90", ierr)
      this%eta(:,:) = 0.0_wp
      this%B(:,:) = 0.0_wp
      this%n(:,:) = 0
      this%etax(:,:) = 0.0_wp
      this%Bx(:,:) = 0.0_wp
      this%C(:,:) = 0.0_wp
      this%D(:,:) = 0.0_wp
      this%damp_dd(:,:) = 0.0_wp
      this%damp_dq(:,:) = 0.0_wp

   end subroutine define_type

   !================================================================================
   subroutine copy_type(this, copy)
      implicit none
      type(MW_xft_t), intent(in) :: this      !> structure to be defined
      type(MW_xft_t), intent(out) :: copy      !> structure to be defined

      ! Local
      ! -----
      integer :: i, j

      call define_type(copy, this%num_species, this%rcut)

      do i=1, copy%num_species
         do j=1, copy%num_species
            copy%eta(i,j) = this%eta(i,j)
            copy%B(i,j) = this%B(i,j)
            copy%n(i,j) = this%n(i,j)
            copy%etax(i,j) = this%etax(i,j)
            copy%Bx(i,j) = this%Bx(i,j)
            copy%C(i,j) = this%C(i,j)
            copy%D(i,j) = this%D(i,j)
            copy%damp_dd(i,j) = this%damp_dd(i,j)
            copy%damp_dq(i,j) = this%damp_dq(i,j)
         end do
      end do

   end subroutine copy_type

   !================================================================================
   ! Void the data structure
   subroutine void_type(this)
      use MW_errors, only: MW_errors_deallocate_error => deallocate_error
      implicit none
      type(MW_xft_t), intent(inout) :: this

      integer :: ierr

      if (allocated(this%eta)) then
         deallocate(this%eta, this%B, this%n, this%etax, this%Bx, this%C, this%D, this%damp_dd, this%damp_dq, stat=ierr)
         if (ierr /= 0) &
               call MW_errors_deallocate_error("define_type", "xft.f90", ierr)
      end if

      this%num_species = 0
      this%rcut = 0.0_wp
      this%rcutsq = 0.0_wp
   end subroutine void_type

   ! ================================================================================
   ! set rcut value
   subroutine set_rcut(this, rcut)
      implicit none
      type(MW_xft_t), intent(inout) :: this
      real(wp), intent(in) :: rcut

      this%rcut = rcut
      this%rcutsq = rcut*rcut
   end subroutine set_rcut

   ! ================================================================================
   subroutine set_parameters(this, typeA, typeB, xft_eta, xft_B, xft_n, &
          xft_etax, xft_Bx, xft_C, xft_D, xft_damp_dd, xft_damp_dq)
      implicit none
      type(MW_xft_t), intent(inout) :: this
      integer, intent(in) :: typeA, typeB
      real(wp), intent(in) :: xft_eta, xft_B, xft_C, xft_D, xft_damp_dd, xft_damp_dq
      real(wp), intent(in) :: xft_etax, xft_Bx
      integer, intent(in) :: xft_n

      this%eta(typeA,typeB) = xft_eta
      this%eta(typeB,typeA) = xft_eta

      this%B(typeA,typeB) = xft_B
      this%B(typeB,typeA) = xft_B

      this%n(typeA,typeB) = xft_n
      this%n(typeB,typeA) = xft_n

      this%etax(typeA,typeB) = xft_etax
      this%etax(typeB,typeA) = xft_etax

      this%Bx(typeA,typeB) = xft_Bx
      this%Bx(typeB,typeA) = xft_Bx

      this%C(typeA,typeB) = xft_C
      this%C(typeB,typeA) = xft_C

      this%D(typeA,typeB) = xft_D
      this%D(typeB,typeA) = xft_D

      this%damp_dd(typeA,typeB) = xft_damp_dd
      this%damp_dd(typeB,typeA) = xft_damp_dd

      this%damp_dq(typeA,typeB) = xft_damp_dq
      this%damp_dq(typeB,typeA) = xft_damp_dq

   end subroutine set_parameters

   ! ================================================================================
   ! mixing rule
   subroutine mixing_rule(this)
      use MW_errors, only : MW_errors_runtime_error => runtime_error     
      implicit none
      type(MW_xft_t), intent(inout) :: this

      ! Local
      integer :: itype, jtype
      real(wp) :: eta1, eta2, B1, B2, C1, C2, D1, D2, damp_dd1, damp_dd2, damp_dq1, damp_dq2
      integer :: n1, n2
      real(wp) :: etax1, etax2, BX1, BX2
      character(256) :: errmsg

      do itype = 1, this%num_species
         do jtype = itype+1, this%num_species
            eta1 = this%eta(itype,itype)
            eta2 = this%eta(jtype,jtype)
            B1 = this%B(itype,itype)
            B2 = this%B(jtype,jtype)
            n1 = this%n(itype,itype)
            n2 = this%n(jtype,jtype)
            etax1 = this%etax(itype,itype)
            etax2 = this%etax(jtype,jtype)
            Bx1 = this%Bx(itype,itype)
            Bx2 = this%Bx(jtype,jtype)
            C1 = this%C(itype,itype)
            C2 = this%C(jtype,jtype)
            D1 = this%D(itype,itype)
            D2 = this%D(jtype,jtype)
            damp_dd1 = this%damp_dd(itype,itype)
            damp_dd2 = this%damp_dd(jtype,jtype)
            damp_dq1 = this%damp_dq(itype,itype)
            damp_dq2 = this%damp_dq(jtype,jtype)
            if ((eta1 .ne. 0) .and. (eta2 .ne. 0) .and. (damp_dd1 .ne. 0) .and. (damp_dd2 .ne. 0) &
                  .and. (damp_dq1 .ne. 0) .and. (damp_dq2 .ne. 0) &
                  .and. (etax1 .ne. 0) .and. (etax2 .ne. 0)) then
               this%eta(itype,jtype) = (eta1 + eta2) * eta1 * eta2 /(eta1**2 + eta2**2)
               this%eta(jtype,itype) = (eta1 + eta2) * eta1 * eta2 /(eta1**2 + eta2**2)
               this%B(itype,jtype) = sqrt(B1 * B2)
               this%B(jtype,itype) = sqrt(B1 * B2)
               this%etax(itype,jtype) = (etax1 + etax2) * etax1 * etax2 /(etax1**2 + etax2**2)
               this%etax(jtype,itype) = (etax1 + etax2) * etax1 * etax2 /(etax1**2 + etax2**2)
               this%Bx(itype,jtype) = sqrt(Bx1 * Bx2)
               this%Bx(jtype,itype) = sqrt(Bx1 * Bx2)
               this%C(itype,jtype) = sqrt(C1 * C2)
               this%C(jtype,itype) = sqrt(C1 * C2)
               this%D(itype,jtype) = sqrt(D1 * D2)
               this%D(jtype,itype) = sqrt(D1 * D2)
               this%damp_dd(itype,jtype) = (damp_dd1 + damp_dd2) * damp_dd1 * damp_dd2 /(damp_dd1**2 + damp_dd2**2)
               this%damp_dd(jtype,itype) = (damp_dd1 + damp_dd2) * damp_dd1 * damp_dd2 /(damp_dd1**2 + damp_dd2**2)
               this%damp_dq(itype,jtype) = (damp_dq1 + damp_dq2) * damp_dq1 * damp_dq2 /(damp_dq1**2 + damp_dq2**2)
               this%damp_dq(jtype,itype) = (damp_dq1 + damp_dq2) * damp_dq1 * damp_dq2 /(damp_dq1**2 + damp_dq2**2)
            end if
            if(n1.eq.n2)then
               this%n(itype,jtype) = n1   
               this%n(jtype,itype) = n1
            else
                write(errmsg, '("impossible to mix 2 XFT potentials with different exponent in the repulsion term")')
                call MW_errors_runtime_error("mixing_rule","xft.F90",errmsg)   
            endif   

         end do
      end do

   end subroutine mixing_rule

   !================================================================================
   ! Print the data structure to ounit
   subroutine print_type(this, species_names, ounit)
      use MW_kinds, only: PARTICLE_NAME_LEN
      implicit none
      type(MW_xft_t), intent(in) :: this               ! structure to be printed
      character(PARTICLE_NAME_LEN),   intent(in) :: species_names(:)   ! names of the species
      integer,                   intent(in) :: ounit              ! output unit

      integer :: i, j

      write(ounit, '("|xft| cut-off distance: ",es12.5)') this%rcut
      write(ounit, '("|xft| ",8x,1x,8x,1x,"    eta     ",1x,"     B      ",1x, &
            &"n  ",1x,"   etax    ",1x,"     Bx     ",1x, &
            &"     C      ",1x,"     D      ",1x, &
            &"  damp_dd   ",1x,"  damp_dq   ",1x)')

      do j = 1, this%num_species
         do i = j, this%num_species
            write(ounit, '("|xft| ",a8,1x,a8,2(1x,es12.5),1x,i1,7(1x,es12.5))') &
                  species_names(i), species_names(j), this%eta(i,j), this%B(i,j),&
                  this%n(i,j), this%etax(i,j), this%Bx(i,j),&
                  this%C(i,j), this%D(i,j), this%damp_dd(i,j), this%damp_dq(i,j)
         end do
      end do

   end subroutine print_type

   ! ==============================================================================
   ! Compute XFT forces felt by melt ions
   subroutine melt_forces(num_pbc, localwork, xft, box, ions, xyz_ions, &
         electrodes, xyz_elec, force,stress_tensor, compute_force)
      implicit none

      ! Parameters in
      ! -------------
      integer, intent(in) :: num_pbc !< number of periodic boundary conditions
      type(MW_localwork_t), intent(in) :: localwork !< Local work assignment
      type(MW_xft_t), intent(in) :: xft      !< XFT potential parameters
      type(MW_box_t),   intent(in) :: box     !< Simulation box parameters

      type(MW_ion_t), intent(in) :: ions(:)        !< ions parameters
      real(wp),       intent(in) :: xyz_ions(:,:)  !< ions xyz positions

      type(MW_electrode_t), intent(inout) :: electrodes(:)  !< electrode parameters
      real(wp),             intent(in) :: xyz_elec(:,:)  !< electrode atoms xyz positions
      logical,              intent(in) :: compute_force !< compute force on electrodes

      ! Parameters out
      ! --------------
      real(wp), intent(inout) :: force(:,:) !< XFT force on ions
      real(wp), intent(inout) :: stress_tensor(:,:) !< XFT forces contribution to the stress tensor

      ! Local
      ! -----
      integer :: i, ierr, count, num_elec_types

      select case(num_pbc)
      case (2)
         call melt_forces_2DPBC(localwork, xft, box, ions, xyz_ions, &
               electrodes, xyz_elec, force, stress_tensor)
      case(3)
         call melt_forces_3DPBC(localwork, xft, box, ions, xyz_ions, &
         electrodes, xyz_elec, force, stress_tensor)
      end select
#ifndef MW_SERIAL
      count = size(force,1) * size(force,2)
      call MPI_Allreduce(MPI_IN_PLACE, force, count, MPI_DOUBLE_PRECISION, MPI_SUM, MW_COMM_WORLD, ierr)

      count = size(stress_tensor,1)*size(stress_tensor,2)      ! this should always be 9
      call MPI_Allreduce(MPI_IN_PLACE, stress_tensor, count, MPI_DOUBLE_PRECISION, MPI_SUM, MW_COMM_WORLD, ierr)      

      if (compute_force) then
         num_elec_types = size(electrodes, 1)
         do i = 1, num_elec_types
               call MPI_Allreduce(MPI_IN_PLACE, electrodes(i)%force_ions(:,8), 3, &
                     MPI_DOUBLE_PRECISION, MPI_SUM, MW_COMM_WORLD, ierr)
         end do
      end if
#endif
   end subroutine melt_forces

   ! ==============================================================================
   ! Compute tail correction to the stress tensor 
   subroutine stress_tensor_tail_correction(xft, box, ions,tail_correction)
      use MW_constants, only : pi     
      implicit none

      ! Parameters in
      ! -------------
      type(MW_xft_t), intent(in) :: xft      !< XFT potential parameters
      type(MW_box_t),   intent(in) :: box     !< Simulation box parameters

      type(MW_ion_t), intent(in) :: ions(:)        !< ions parameters

      ! Parameters out
      ! --------------
      real(wp), intent(inout) :: tail_correction !< tail correction to the stress tensor

      ! Local
      ! -----
      integer :: itype,jtype,num_ion_types
      integer :: count_n,count_m
      real(wp) :: rcutsq,rcut,C_ij,D_ij

      num_ion_types = size(ions,1)

      rcutsq = xft%rcutsq
      rcut=sqrt(rcutsq)
      tail_correction=0.0_wp
      do itype = 1, num_ion_types
         count_n = ions(itype)%count
!        do jtype =  itype, num_ion_types
         do jtype =  1, num_ion_types
            count_m = ions(jtype)%count
            C_ij = xft%C(itype, jtype)
            D_ij = xft%D(itype, jtype)
            tail_correction=tail_correction- &
                    2.0*pi*count_m*count_n/product(box%length(:))*(C_ij*2.0/(rcut**3.0)+D_ij*(8.0/5.0)/(rcut**5.0))
         end do
      end do

   end subroutine stress_tensor_tail_correction   

   ! ==============================================================================
   ! Compute XFT potential felt by melt ions
   subroutine energy(num_pbc, localwork, xft, box, ions, xyz_ions, &
         electrodes, xyz_atoms, h)
      implicit none

      ! Parameters in
      ! -------------
      integer, intent(in) :: num_pbc !< number of periodic boundary conditions
      type(MW_localwork_t), intent(in) :: localwork !< Local work assignment
      type(MW_xft_t), intent(in) :: xft      !< XFT potential parameters
      type(MW_box_t),   intent(in) :: box     !< Simulation box parameters

      type(MW_ion_t), intent(in) :: ions(:)        !< ions parameters
      real(wp),       intent(in) :: xyz_ions(:,:)  !< ions xyz positions

      type(MW_electrode_t), intent(in) :: electrodes(:)  !< electrode parameters
      real(wp),             intent(in) :: xyz_atoms(:,:)  !< electrode atoms xyz positions

      ! Parameters out
      ! --------------
      real(wp), intent(inout) :: h       !< Potential energy due to L-J interactions

      ! Local
      ! -----
      integer :: ierr

      select case(num_pbc)
      case (2)
         call energy_2DPBC(localwork, xft, box, ions, xyz_ions, &
         electrodes, xyz_atoms, h)
      case(3)
         call energy_3DPBC(localwork, xft, box, ions, xyz_ions, &
         electrodes, xyz_atoms, h)
      end select
#ifndef MW_SERIAL
      call MPI_Allreduce(MPI_IN_PLACE, h, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MW_COMM_WORLD, ierr)
#endif
   end subroutine energy

   ! ================================================================================
   ! Remove contribution from same molecule particles
   !
   subroutine melt_fix_molecule_forces(num_pbc, localwork, xft, molecules, box, ions, &
         xyz_ions, force,stress_tensor)
      implicit none
      ! Parameters
      ! ----------
      integer, intent(in) :: num_pbc
      type(MW_localwork_t), intent(in) :: localwork
      type(MW_xft_t), intent(in) :: xft      !< XFT potential parameters
      type(MW_molecule_t), intent(in) :: molecules(:) !< molecules parameters
      type(MW_box_t), intent(in) :: box !< box parameters
      type(MW_ion_t), intent(in) :: ions(:) !< ions parameters
      real(wp), intent(in) :: xyz_ions(:,:) !< melt particles coordinates
      real(wp), intent(inout) :: force(:,:) !< force on melt particles
      real(wp), intent(inout) :: stress_tensor(:,:) !< stress tensor

      ! Local
      ! -----
      integer :: ierr, count

      select case(num_pbc)
      case (2)
         call melt_fix_molecule_forces_2DPBC(localwork, xft, molecules, box, ions, &
         xyz_ions, force,stress_tensor)
      case(3)
         call melt_fix_molecule_forces_3DPBC(localwork, xft, molecules, box, ions, &
         xyz_ions, force,stress_tensor)
      end select
#ifndef MW_SERIAL
      count = size(force,1) * size(force,2)
      call MPI_Allreduce(MPI_IN_PLACE, force, count, MPI_DOUBLE_PRECISION, MPI_SUM, MW_COMM_WORLD, ierr)

      count = size(stress_tensor,1)*size(stress_tensor,2)      ! this should always be 9
      call MPI_Allreduce(MPI_IN_PLACE, stress_tensor, count, MPI_DOUBLE_PRECISION, MPI_SUM, MW_COMM_WORLD, ierr)      
#endif
   end subroutine melt_fix_molecule_forces

   ! ================================================================================
   ! Remove contribution from same molecule particles
   !
   subroutine fix_molecule_energy(num_pbc, localwork, xft, molecules, box, ions, &
         xyz_ions, h)
      implicit none
      ! Parameters
      ! ----------
      integer, intent(in) :: num_pbc !< number of periodic boundary conditions
      type(MW_localwork_t), intent(in) :: localwork
      type(MW_xft_t), intent(in) :: xft      !< Fumi-Tosi potential parameters
      type(MW_molecule_t), intent(in) :: molecules(:) !< molecules parameters
      type(MW_box_t), intent(in) :: box !< box parameters
      type(MW_ion_t), intent(in) :: ions(:) !< melt particle parameters
      real(wp), intent(in) :: xyz_ions(:,:) !< melt particles coordinates
      real(wp), intent(inout) :: h !< potential on melt particles

      ! Local
      ! -----
      integer :: ierr

      select case(num_pbc)
      case (2)
         call fix_molecule_energy_2DPBC(localwork, xft, molecules, box, ions, &
               xyz_ions, h)
      case(3)
         call fix_molecule_energy_3DPBC(localwork, xft, molecules, box, ions, &
               xyz_ions, h)
      end select
#ifndef MW_SERIAL
      call MPI_Allreduce(MPI_IN_PLACE, h, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MW_COMM_WORLD, ierr)
#endif
   end subroutine fix_molecule_energy

   ! ================================================================================
   ! Function to compute force coeffcient between 2 particles
   !
   ! ft_ij = (dV(r_ij) / dr_ij) * (1/ r_ij)
   pure function force_ij(drnorm2, eta_ij, B_ij, n_ij, etax_ij, Bx_ij, &
                   C_ij, D_ij, damp_dd_ij, damp_dq_ij) result(xft_ij)
      implicit none
      ! Passed in
      ! ---------
      integer, intent(in)  :: n_ij
      real(wp), intent(in) :: drnorm2
      real(wp), intent(in) :: eta_ij
      real(wp), intent(in) :: B_ij
      real(wp), intent(in) :: etax_ij
      real(wp), intent(in) :: Bx_ij
      real(wp), intent(in) :: C_ij
      real(wp), intent(in) :: D_ij
      real(wp), intent(in) :: damp_dd_ij
      real(wp), intent(in) :: damp_dq_ij

      ! Result
      ! ------
      real(wp) :: xft_ij

      ! Local
      ! -----

      real(wp) :: drnorm, drnormrec, drnorm2rec, drnorm6rec, drnorm8rec
      real(wp) :: drnormnrec
      real(wp) :: damp_dd_sum, damp_dd_term
      real(wp) :: damp_dq_sum, damp_dq_term
      integer :: k, l
      drnorm = sqrt(drnorm2)
      drnormrec  = 1.0_wp / drnorm
      drnormnrec = drnormrec**n_ij
      drnorm2rec = drnormrec * drnormrec
      drnorm6rec = drnorm2rec * drnorm2rec * drnorm2rec
      drnorm8rec = drnorm2rec * drnorm6rec

      ! damp_dd_sum = sum_{k=0}^{6} (d_{dd}^k r_{ij}^k) / k!
      damp_dd_sum = 1.0_wp
      damp_dd_term = 1.0_wp
      do k = 1, 6
         damp_dd_term = damp_dd_term * (damp_dd_ij * drnorm / real(k,wp)) ! damp_dd_term =  (d_{dd}^k r_{ij}^k) / k!
         damp_dd_sum = damp_dd_sum + damp_dd_term
      end do

      ! damp_dq_sum = sum_{k=0}^{8} (d_{dq}^k r_{ij}^k) / k!
      damp_dq_sum = 1.0_wp
      damp_dq_term = 1.0_wp
      do l = 1, 8
         damp_dq_term = damp_dq_term * (damp_dq_ij * drnorm / real(l,wp)) ! damp_dq_term =  (d_{dq}^k r_{ij}^k) / k!
         damp_dq_sum = damp_dq_sum + damp_dq_term
      end do

      xft_ij = -eta_ij * B_ij * exp(-eta_ij*drnorm)*drnormnrec &
            -  B_ij * exp(-eta_ij*drnorm) * drnormnrec * drnormrec * real(n_ij,wp) &
            -  etax_ij * Bx_ij * 2.0_wp * drnorm * exp(-etax_ij*drnorm2) &            
            + (C_ij * drnorm6rec) * (6.0_wp * drnormrec * (1.0_wp - damp_dd_sum*exp(-damp_dd_ij*drnorm)) &
            - damp_dd_ij * damp_dd_term * exp(-damp_dd_ij * drnorm)) &
            + (D_ij * drnorm8rec) * (8.0_wp * drnormrec * (1.0_wp - damp_dq_sum*exp(-damp_dq_ij*drnorm)) &
            - damp_dq_ij * damp_dq_term * exp(-damp_dq_ij * drnorm))

      xft_ij = xft_ij * drnormrec
   end function force_ij

   ! ================================================================================
   ! Function to compute the potential felt between 2 particles
   !
   ! ft_ij = V(r_ij)
   pure function potential_ij(drnorm2, eta_ij, B_ij, n_ij,  etax_ij, Bx_ij, &
                   C_ij, D_ij, damp_dd_ij, damp_dq_ij) result(xft_ij)
      implicit none
      ! Passed in
      ! ---------
      integer, intent(in)  :: n_ij
      real(wp), intent(in) :: drnorm2
      real(wp), intent(in) :: eta_ij
      real(wp), intent(in) :: B_ij
      real(wp), intent(in) :: etax_ij
      real(wp), intent(in) :: Bx_ij
      real(wp), intent(in) :: C_ij
      real(wp), intent(in) :: D_ij
      real(wp), intent(in) :: damp_dd_ij
      real(wp), intent(in) :: damp_dq_ij

      ! Result
      ! ------
      real(wp) :: xft_ij

      ! Local
      ! -----
      real(wp) :: drnorm, drnorm2rec, drnorm6rec, drnorm8rec
      real(wp) :: drnormrec, drnormnrec
      real(wp) :: damp_dd_sum, damp_dd_term
      real(wp) :: damp_dq_sum, damp_dq_term
      integer :: k, l

      drnorm = sqrt(drnorm2)
      drnormrec = 1.0_wp / drnorm
      drnormnrec = drnormrec**n_ij
      drnorm2rec = drnormrec*drnormrec      
      drnorm6rec = drnorm2rec * drnorm2rec * drnorm2rec
      drnorm8rec = drnorm2rec * drnorm6rec

      ! damp_dd_sum = sum_{k=0}^{6} (d_{dd}^k r_{ij}^k) / k!
      damp_dd_sum = 1.0_wp
      damp_dd_term = 1.0_wp
      do k = 1, 6
         damp_dd_term = damp_dd_term * (damp_dd_ij * drnorm / real(k,wp)) ! damp_dd_term =  (d_{dd}^k r_{ij}^k) / k!
         damp_dd_sum = damp_dd_sum + damp_dd_term
      end do

      ! damp_dq_sum = sum_{k=0}^{8} (d_{dq}^k r_{ij}^k) / k!
      damp_dq_sum = 1.0_wp
      damp_dq_term = 1.0_wp
      do l = 1, 8
         damp_dq_term = damp_dq_term * (damp_dq_ij * drnorm / real(l,wp)) ! damp_dq_term =  (d_{dq}^k r_{ij}^k) / k!
         damp_dq_sum = damp_dq_sum + damp_dq_term
      end do

      xft_ij = B_ij * exp(-eta_ij * drnorm)*drnormnrec &
            +  Bx_ij * exp(-etax_ij*drnorm2) &            
            - C_ij * drnorm6rec * (1.0_wp - damp_dd_sum*exp(-damp_dd_ij*drnorm)) &
            - D_ij * drnorm8rec * (1.0_wp - damp_dq_sum*exp(-damp_dq_ij*drnorm))
   end function potential_ij

   ! ================================================================================
   include 'xft_2DPBC.inc'
   include 'xft_3DPBC.inc'
   ! ================================================================================
   include 'minimum_image_displacement_2DPBC.inc'
   include 'minimum_image_displacement_3DPBC.inc'
   include 'minimum_image_distance_2DPBC.inc'
   include 'minimum_image_distance_3DPBC.inc'
   ! ================================================================================
   include 'update_diag_block_boundaries.inc'
   include 'update_tri_block_boundaries.inc'
   include 'update_other_block_boundaries.inc'

end module MW_xft
