! ==============================================================================
! Compute XFT forces felt by melt ions
!DEC$ ATTRIBUTES NOINLINE :: melt_forces_@PBC@
subroutine melt_forces_@PBC@(localwork, xft, box, ions, xyz_ions, &
      electrodes, xyz_atoms, force, stress_tensor)
   implicit none

   ! Parameters in
   ! -------------
   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_atoms(:,:)  !< electrode atoms xyz positions

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

   ! Locals
   ! ------
   integer :: num_ion_types, num_elec
   integer :: itype, jtype, i, j
   real(wp) :: a, b, c, rcutsq
   real(wp) :: drnorm2, dx, dy, dz, fix, fiy, fiz
   real(wp) :: xft_ij, eta_ij, B_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij
   real(wp) :: etax_ij, Bx_ij
   integer :: n_ij
   integer :: num_block_diag, num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n, count_m, offset_m

   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
   real(wp) :: loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz
   real(wp) :: loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz
   real(wp) :: loc_electrode_force_x, loc_electrode_force_y, loc_electrode_force_z   

   call MW_timers_start(TIMER_VAN_DER_WAALS_MELT_FORCES)   

   num_ion_types = size(ions,1)
   num_elec = size(electrodes,1)

   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   rcutsq = xft%rcutsq

   loc_stress_tensor_xx = 0.0_wp
   loc_stress_tensor_yy = 0.0_wp
   loc_stress_tensor_zz = 0.0_wp
   loc_stress_tensor_xy = 0.0_wp
   loc_stress_tensor_xz = 0.0_wp
   loc_stress_tensor_yz = 0.0_wp 

   !$acc data present(xyz_ions(:,:), xyz_atoms(:,:), force(:,:), &
   !$acc              electrodes, electrodes%force_ions)  &
   !$acc      copy(loc_stress_tensor_xx,loc_stress_tensor_yy,loc_stress_tensor_zz, &
   !$acc           loc_stress_tensor_xy,loc_stress_tensor_xz,loc_stress_tensor_yz, &
   !$acc           loc_electrode_force_x, loc_electrode_force_y, loc_electrode_force_z)

   ! Blocks on the diagonal compute only half of the pair interactions
   do itype = 1, num_ion_types
      count_n = ions(itype)%count
      offset_n = ions(itype)%offset
      do jtype = 1, itype - 1
         count_m = ions(jtype)%count
         offset_m = ions(jtype)%offset
         eta_ij = xft%eta(itype, jtype)
         B_ij = xft%B(itype, jtype)
         n_ij = xft%n(itype, jtype)
         etax_ij = xft%etax(itype, jtype)
         Bx_ij = xft%Bx(itype, jtype)
         C_ij = xft%C(itype, jtype)
         D_ij = xft%D(itype, jtype)
         damp_dd_ij = xft%damp_dd(itype, jtype)
         damp_dq_ij = xft%damp_dq(itype, jtype)
         ! Number of blocks with full ion2ion interactions
         num_block_full = localwork%pair_ion2ion_num_block_full_local(itype, jtype)
         iblock_offset = localwork%pair_ion2ion_full_iblock_offset(itype, jtype)
         do iblock = 1, num_block_full
            call update_other_block_boundaries(iblock_offset+iblock, &
                  offset_n, count_n, offset_m, count_m, &
                  istart, iend, jstart, jend)
            !$acc parallel loop private(fix, fiy, fiz) &
            !$acc reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz, &
            !$acc             loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)
            do i = istart, iend
               fix = 0.0_wp
               fiy = 0.0_wp
               fiz = 0.0_wp
               !$acc loop reduction(+:fix,fiy,fiz) &
               !$acc private(drnorm2, dx, dy, dz, xft_ij, drnorm, drnormrec, drnorm2rec, drnorm6rec, drnorm8rec, &
               !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l) &
               !$acc reduction(+:loc_stress_tensor_xx,&
               !$acc                       loc_stress_tensor_yy,loc_stress_tensor_zz, &
               !$acc                       loc_stress_tensor_xy,loc_stress_tensor_xz, &
               !$acc                       loc_stress_tensor_yz)
               do j = jstart, jend
                  call minimum_image_displacement_@PBC@(a, b, c, &
                        xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                        xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                        dx, dy, dz, drnorm2)
                  if (drnorm2 < rcutsq) then
                     ! xft_ij = force_ij(drnorm2, eta_ij, B_ij, n_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij)
                     include 'xft_forceij.inc'

                     fix = fix +  dx * xft_ij
                     fiy = fiy +  dy * xft_ij
                     fiz = fiz +  dz * xft_ij

                     !$acc atomic update
                     force(j,1) = force(j,1) - dx * xft_ij
                     !$acc atomic update
                     force(j,2) = force(j,2) - dy * xft_ij
                     !$acc atomic update
                     force(j,3) = force(j,3) - dz * xft_ij

                     loc_stress_tensor_xx = loc_stress_tensor_xx - dx * dx * xft_ij
                     loc_stress_tensor_yy = loc_stress_tensor_yy - dy * dy * xft_ij
                     loc_stress_tensor_zz = loc_stress_tensor_zz - dz * dz * xft_ij
                     loc_stress_tensor_xy = loc_stress_tensor_xy - dx * dy * xft_ij
                     loc_stress_tensor_xz = loc_stress_tensor_xz - dx * dz * xft_ij
                     loc_stress_tensor_yz = loc_stress_tensor_yz - dy * dz * xft_ij

                  end if
               end do
               !$acc end loop
               force(i,1) = force(i,1) + fix
               force(i,2) = force(i,2) + fiy
               force(i,3) = force(i,3) + fiz
            end do
            !$acc end parallel loop
         end do
      end do

      eta_ij = xft%eta(itype, jtype)
      B_ij = xft%B(itype, jtype)
      n_ij = xft%n(itype, jtype)
      etax_ij = xft%etax(itype, jtype)
      Bx_ij = xft%Bx(itype, jtype)
      C_ij = xft%C(itype, jtype)
      D_ij = xft%D(itype, jtype)
      damp_dd_ij = xft%damp_dd(itype, jtype)
      damp_dq_ij = xft%damp_dq(itype, jtype)

      num_block_diag = localwork%pair_ion2ion_num_block_diag_local(itype)
      iblock_offset = localwork%pair_ion2ion_diag_iblock_offset(itype)
      do iblock = 1, num_block_diag
         call update_diag_block_boundaries(iblock_offset+iblock, &
               offset_n, count_n, istart, iend)
         !$acc parallel loop private(fix, fiy, fiz) &
         !$acc reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz, &
         !$acc             loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)       
         do i = istart, iend
            fix = 0.0_wp
            fiy = 0.0_wp
            fiz = 0.0_wp
            !$acc loop reduction(+:fix,fiy,fiz) &
            !$acc private(drnorm2, dx, dy, dz, xft_ij, drnorm, drnormrec, drnorm2rec, drnorm6rec, drnorm8rec, &
            !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l) &
            !$acc reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz, &
            !$acc             loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)
            do j = istart, iend
               call minimum_image_displacement_@PBC@(a, b, c, &
                     xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                     xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                     dx, dy, dz, drnorm2)
               if ((drnorm2 > 0.0_wp) .and. (drnorm2 < rcutsq)) then
                  ! xft_ij = force_ij(drnorm2, eta_ij, B_ij, n_ij C_ij, D_ij, damp_dd_ij, damp_dq_ij)
                     include 'xft_forceij.inc'
                  fix = fix +  dx * xft_ij
                  fiy = fiy +  dy * xft_ij
                  fiz = fiz +  dz * xft_ij

                  loc_stress_tensor_xx = loc_stress_tensor_xx - 0.5_wp * dx * dx * xft_ij
                  loc_stress_tensor_yy = loc_stress_tensor_yy - 0.5_wp * dy * dy * xft_ij
                  loc_stress_tensor_zz = loc_stress_tensor_zz - 0.5_wp * dz * dz * xft_ij
                  loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * dx * dy * xft_ij
                  loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * dx * dz * xft_ij
                  loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * dy * dz * xft_ij

               end if
            end do
            !$acc end loop
            force(i,1) = force(i,1) + fix
            force(i,2) = force(i,2) + fiy
            force(i,3) = force(i,3) + fiz
         end do
         !$acc end parallel loop
      end do

      ! Number of blocks with full ion2ion interactions
      num_block_full = localwork%pair_ion2ion_num_block_full_local(itype,itype)
      iblock_offset = localwork%pair_ion2ion_full_iblock_offset(itype,itype)
      do iblock = 1, num_block_full
         call update_tri_block_boundaries(iblock_offset+iblock, offset_n, count_n, &
               istart, iend, jstart, jend)
         !$acc parallel loop private(fix, fiy, fiz) &
         !$acc               reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz, &
         !$acc                           loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)       
         do i = istart, iend
            fix = 0.0_wp
            fiy = 0.0_wp
            fiz = 0.0_wp
    
            !$acc loop reduction(+:fix,fiy,fiz) &
            !$acc private(drnorm2, dx, dy, dz, xft_ij, drnorm, drnormrec, drnorm2rec, drnorm6rec, drnorm8rec, &
            !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l) &
            !$acc reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz, &
            !$acc             loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)
            do j = jstart, jend
               call minimum_image_displacement_@PBC@(a, b, c, &
                     xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                     xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                     dx, dy, dz, drnorm2)
               if (drnorm2 < rcutsq) then
                  ! xft_ij = force_ij(drnorm2, eta_ij, B_ij, n_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij)
                     include 'xft_forceij.inc'

                  fix = fix +  dx * xft_ij
                  fiy = fiy +  dy * xft_ij
                  fiz = fiz +  dz * xft_ij

                  !$acc atomic update
                  force(j,1) = force(j,1) - dx * xft_ij
                  !$acc atomic update
                  force(j,2) = force(j,2) - dy * xft_ij
                  !$acc atomic update
                  force(j,3) = force(j,3) - dz * xft_ij

                  loc_stress_tensor_xx = loc_stress_tensor_xx - dx * dx * xft_ij
                  loc_stress_tensor_yy = loc_stress_tensor_yy - dy * dy * xft_ij
                  loc_stress_tensor_zz = loc_stress_tensor_zz - dz * dz * xft_ij
                  loc_stress_tensor_xy = loc_stress_tensor_xy - dx * dy * xft_ij
                  loc_stress_tensor_xz = loc_stress_tensor_xz - dx * dz * xft_ij
                  loc_stress_tensor_yz = loc_stress_tensor_yz - dy * dz * xft_ij  

               end if
            end do
            !$acc end loop
            force(i,1) = force(i,1) + fix
            force(i,2) = force(i,2) + fiy
            force(i,3) = force(i,3) + fiz
         end do
         !$acc end parallel loop
      end do

      do jtype = 1, num_elec
         count_m = electrodes(jtype)%count
         offset_m = electrodes(jtype)%offset

         eta_ij = xft%eta(itype, jtype+num_ion_types)
         B_ij = xft%B(itype, jtype+num_ion_types)
         n_ij = xft%n(itype, jtype+num_ion_types)
         etax_ij = xft%etax(itype, jtype+num_ion_types)
         Bx_ij = xft%Bx(itype, jtype+num_ion_types)
         C_ij = xft%C(itype, jtype+num_ion_types)
         D_ij = xft%D(itype, jtype+num_ion_types)
         damp_dd_ij = xft%damp_dd(itype, jtype+num_ion_types)
         damp_dq_ij = xft%damp_dq(itype, jtype+num_ion_types)

         ! Number of blocks with full atom2ions interactions
         num_block_full = localwork%pair_atom2ion_num_block_full_local(itype, jtype)
         iblock_offset = localwork%pair_atom2ion_full_iblock_offset(itype, jtype)
         do iblock = 1, num_block_full
            loc_electrode_force_x = 0.0_wp
            loc_electrode_force_y = 0.0_wp
            loc_electrode_force_z = 0.0_wp 
            call update_other_block_boundaries(iblock_offset+iblock, &
                  offset_n, count_n, offset_m, count_m, &
                  istart, iend, jstart, jend)
            !$acc parallel loop private(fix, fiy, fiz) &
            !$acc               reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz, &
            !$acc                           loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz, &
            !$acc                           loc_electrode_force_x, loc_electrode_force_y, loc_electrode_force_z)
            do i = istart, iend
               fix = 0.0_wp
               fiy = 0.0_wp
               fiz = 0.0_wp
               !$acc loop reduction(+:fix,fiy,fiz) &
               !$acc private(drnorm2, dx, dy, dz, xft_ij, drnorm, drnormrec, drnorm2rec, drnorm6rec, drnorm8rec, &
               !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l) &
               !$acc reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz, &
               !$acc             loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)
               do j = jstart, jend
                  call minimum_image_displacement_@PBC@(a, b, c, &
                        xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                        xyz_atoms(j,1), xyz_atoms(j,2), xyz_atoms(j,3), &
                        dx, dy, dz, drnorm2)
                  if (drnorm2 < rcutsq) then
                     ! xft_ij = force_ij(drnorm2, eta_ij, B_ij, n_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij)
                     include 'xft_forceij.inc'
                     fix = fix +  dx * xft_ij
                     fiy = fiy +  dy * xft_ij
                     fiz = fiz +  dz * xft_ij

                     ! Is this meaningful?
                     loc_stress_tensor_xx = loc_stress_tensor_xx - dx * dx * xft_ij
                     loc_stress_tensor_yy = loc_stress_tensor_yy - dy * dy * xft_ij
                     loc_stress_tensor_zz = loc_stress_tensor_zz - dz * dz * xft_ij
                     loc_stress_tensor_xy = loc_stress_tensor_xy - dx * dy * xft_ij
                     loc_stress_tensor_xz = loc_stress_tensor_xz - dx * dz * xft_ij
                     loc_stress_tensor_yz = loc_stress_tensor_yz - dy * dz * xft_ij
                  end if
               end do
               !$acc end loop
               force(i,1) = force(i,1) + fix
               force(i,2) = force(i,2) + fiy
               force(i,3) = force(i,3) + fiz
               loc_electrode_force_x = loc_electrode_force_x - fix
               loc_electrode_force_y = loc_electrode_force_y - fiy
               loc_electrode_force_z = loc_electrode_force_z - fiz     
            end do
            !$acc end parallel loop
            electrodes(jtype)%force_ions(1,8) = electrodes(jtype)%force_ions(1,8) + loc_electrode_force_x
            electrodes(jtype)%force_ions(2,8) = electrodes(jtype)%force_ions(2,8) + loc_electrode_force_y
            electrodes(jtype)%force_ions(3,8) = electrodes(jtype)%force_ions(3,8) + loc_electrode_force_z
         end do
      end do
   end do
   !$acc end data
   stress_tensor(1,1) = loc_stress_tensor_xx 
   stress_tensor(2,2) = loc_stress_tensor_yy
   stress_tensor(3,3) = loc_stress_tensor_zz
   stress_tensor(1,2) = loc_stress_tensor_xy
   stress_tensor(1,3) = loc_stress_tensor_xz
   stress_tensor(2,3) = loc_stress_tensor_yz

   call MW_timers_stop(TIMER_VAN_DER_WAALS_MELT_FORCES)   
end subroutine melt_forces_@PBC@

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

   ! Parameters in
   ! -------------
   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

   ! Locals
   ! ------
   integer :: num_ion_types, num_elec
   integer :: itype, jtype, i, j
   real(wp) :: a, b, c
   real(wp) :: drnorm2, rcutsq
   real(wp) :: vi
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: num_block_diag, num_block_full
   integer :: count_n, offset_n, count_m, offset_m
   integer :: n_ij
   real(wp) :: xft_ij, eta_ij, B_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij
   real(wp) :: etax_ij, Bx_ij
   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

   call MW_timers_start(TIMER_VAN_DER_WAALS_MELT_POTENTIAL)

   num_ion_types = size(ions,1)
   num_elec = size(electrodes,1)

   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   rcutsq = xft%rcutsq
   h = 0.0_wp
   vi = 0.0_wp

   !$acc data present(xyz_ions(:,:), xyz_atoms(:,:)) copy(vi)

   ! Blocks on the diagonal compute only half of the pair interactions
   do itype = 1, num_ion_types
      count_n = ions(itype)%count
      offset_n = ions(itype)%offset
      do jtype = 1, itype - 1
         count_m = ions(jtype)%count
         offset_m = ions(jtype)%offset
         eta_ij = xft%eta(itype, jtype)
         B_ij = xft%B(itype, jtype)
         n_ij = xft%n(itype, jtype)
         etax_ij = xft%etax(itype, jtype)
         Bx_ij = xft%Bx(itype, jtype)
         C_ij = xft%C(itype, jtype)
         D_ij = xft%D(itype, jtype)
         damp_dd_ij = xft%damp_dd(itype, jtype)
         damp_dq_ij = xft%damp_dq(itype, jtype)
         ! Number of blocks with full ion2ion interactions
         num_block_full = localwork%pair_ion2ion_num_block_full_local(itype, jtype)
         iblock_offset = localwork%pair_ion2ion_full_iblock_offset(itype, jtype)

         do iblock = 1, num_block_full
            call update_other_block_boundaries(iblock+iblock_offset, &
                  offset_n, count_n, offset_m, count_m, &
                  istart, iend, jstart, jend)
            !$acc parallel loop collapse(2) reduction(+:vi) &
            !$acc private(xft_ij, drnorm, drnorm2rec, drnorm6rec, drnorm8rec, &
            !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l)
            do i = istart, iend
               do j = jstart, jend
                  call minimum_image_distance_@PBC@(a, b, c, &
                        xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                        xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                        drnorm2)
                  if (drnorm2 < rcutsq) then
                     include 'xft_potentialij.inc'
                     vi = vi + xft_ij
                  end if
               end do
            end do
            !$acc end parallel loop
         end do
      end do

      eta_ij = xft%eta(itype, itype)
      B_ij = xft%B(itype, itype)
      n_ij = xft%n(itype, itype)
      etax_ij = xft%etax(itype, itype)
      Bx_ij = xft%Bx(itype, itype)
      C_ij = xft%C(itype, itype)
      D_ij = xft%D(itype, itype)
      damp_dd_ij = xft%damp_dd(itype, itype)
      damp_dq_ij = xft%damp_dq(itype, itype)

      num_block_diag = localwork%pair_ion2ion_num_block_diag_local(itype)
      iblock_offset = localwork%pair_ion2ion_diag_iblock_offset(itype)
      do iblock = 1, num_block_diag
         call update_diag_block_boundaries(iblock_offset+iblock, offset_n, count_n, istart, iend)
         !$acc parallel loop collapse(2) reduction(+:vi) &
         !$acc private(xft_ij, drnorm, drnorm2rec, drnorm6rec, drnorm8rec, &
         !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l)
         do i = istart, iend
            do j = istart, iend
               call minimum_image_distance_@PBC@(a, b, c, &
                     xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                     xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                     drnorm2)
               if ((drnorm2 > 0.0_wp) .and. (drnorm2 < rcutsq)) then
                  include 'xft_potentialij.inc'
                  vi = vi + 0.5_wp * xft_ij
               end if
            end do
         end do
         !$acc end parallel loop
      end do

      ! Number of blocks with full ion2ion interactions
      num_block_full = localwork%pair_ion2ion_num_block_full_local(itype,itype)
      iblock_offset = localwork%pair_ion2ion_full_iblock_offset(itype,itype)
      do iblock = 1, num_block_full
         call update_tri_block_boundaries(iblock_offset+iblock, offset_n, count_n, &
               istart, iend, jstart, jend)
         !$acc parallel loop collapse(2) reduction(+:vi) &
         !$acc private(xft_ij, drnorm, drnorm2rec, drnorm6rec, drnorm8rec, &
         !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l)
         do i = istart, iend
            do j = jstart, jend
               call minimum_image_distance_@PBC@(a, b, c, &
                     xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                     xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                     drnorm2)
               if (drnorm2 < rcutsq) then
                  include 'xft_potentialij.inc'
                  vi = vi + xft_ij
               end if
            end do
         end do
         !$acc end parallel loop
      end do

      do jtype = 1, num_elec
         count_m = electrodes(jtype)%count
         offset_m = electrodes(jtype)%offset

         eta_ij = xft%eta(itype, jtype+num_ion_types)
         B_ij = xft%B(itype, jtype+num_ion_types)
         n_ij = xft%n(itype, jtype+num_ion_types)
         etax_ij = xft%etax(itype, jtype+num_ion_types)
         Bx_ij = xft%Bx(itype, jtype+num_ion_types)
         C_ij = xft%C(itype, jtype+num_ion_types)
         D_ij = xft%D(itype, jtype+num_ion_types)
         damp_dd_ij = xft%damp_dd(itype, jtype+num_ion_types)
         damp_dq_ij = xft%damp_dq(itype, jtype+num_ion_types)

         ! Number of blocks with full ion2ion interactions
         num_block_full = localwork%pair_atom2ion_num_block_full_local(itype, jtype)
         iblock_offset = localwork%pair_atom2ion_full_iblock_offset(itype, jtype)

         do iblock = 1, num_block_full
            call update_other_block_boundaries(iblock+iblock_offset, &
                  offset_n, count_n, offset_m, count_m, &
                  istart, iend, jstart, jend)
            !$acc parallel loop collapse(2) reduction(+:vi) &
            !$acc private(xft_ij, drnorm, drnorm2rec, drnorm6rec, drnorm8rec, &
            !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l)
            do i = istart, iend
               do j = jstart, jend
                  call minimum_image_distance_@PBC@(a, b, c, &
                        xyz_ions(i,1), xyz_ions(i,2), xyz_ions(i,3), &
                        xyz_atoms(j,1), xyz_atoms(j,2), xyz_atoms(j,3), &
                        drnorm2)
                  if (drnorm2 < rcutsq) then
                     include 'xft_potentialij.inc'
                     vi = vi + xft_ij
                  end if
               end do
            end do
            !$acc end parallel loop
         end do
      end do
   end do

   ! Elec->Elec contribution
   do itype = 1, num_elec
      count_n = electrodes(itype)%count
      offset_n = electrodes(itype)%offset
      do jtype = 1, itype-1
         count_m =  electrodes(jtype)%count
         offset_m = electrodes(jtype)%offset

         eta_ij = xft%eta(itype+num_ion_types, jtype+num_ion_types)
         B_ij = xft%B(itype+num_ion_types, jtype+num_ion_types)
         n_ij = xft%n(itype+num_ion_types, jtype+num_ion_types)
         etax_ij = xft%etax(itype+num_ion_types, jtype+num_ion_types)
         Bx_ij = xft%Bx(itype+num_ion_types, jtype+num_ion_types)
         C_ij = xft%C(itype+num_ion_types, jtype+num_ion_types)
         D_ij = xft%D(itype+num_ion_types, jtype+num_ion_types)
         damp_dd_ij = xft%damp_dd(itype+num_ion_types, jtype+num_ion_types)
         damp_dq_ij = xft%damp_dq(itype+num_ion_types, jtype+num_ion_types)
         ! Number of blocks with full interactions (below the diagonal
         num_block_full = localwork%pair_atom2atom_num_block_full_local(itype,jtype)
         iblock_offset = localwork%pair_atom2atom_full_iblock_offset(itype,jtype)

         do iblock = 1, num_block_full
            call update_other_block_boundaries(iblock_offset+iblock, &
                  offset_n, count_n, offset_m, count_m, istart, iend, jstart, jend)
            !$acc parallel loop collapse(2) reduction(+:vi) &
            !$acc private(xft_ij, drnorm, drnorm2rec, drnorm6rec, drnorm8rec, &
            !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l)
            do i = istart, iend
               do j = jstart, jend
                  call minimum_image_distance_@PBC@(a, b, c, &
                        xyz_atoms(i,1), xyz_atoms(i,2), xyz_atoms(i,3), &
                        xyz_atoms(j,1), xyz_atoms(j,2), xyz_atoms(j,3), &
                        drnorm2)
                  if (drnorm2 < rcutsq)  then
                     include 'xft_potentialij.inc'
                     vi = vi + xft_ij
                  end if
               end do
            end do
            !$acc end parallel loop
         end do
      end do

      eta_ij = xft%eta(itype+num_ion_types, itype+num_ion_types)
      B_ij = xft%B(itype+num_ion_types, itype+num_ion_types)
      n_ij = xft%n(itype+num_ion_types, itype+num_ion_types)
      etax_ij = xft%etax(itype+num_ion_types, itype+num_ion_types)
      Bx_ij = xft%Bx(itype+num_ion_types, itype+num_ion_types)
      C_ij = xft%C(itype+num_ion_types, itype+num_ion_types)
      D_ij = xft%D(itype+num_ion_types, itype+num_ion_types)
      damp_dd_ij = xft%damp_dd(itype+num_ion_types, itype+num_ion_types)
      damp_dq_ij = xft%damp_dq(itype+num_ion_types, itype+num_ion_types)
      num_block_diag = localwork%pair_atom2atom_num_block_diag_local(itype)
      iblock_offset = localwork%pair_atom2atom_diag_iblock_offset(itype)

      do iblock = 1, num_block_diag
         call update_diag_block_boundaries(iblock+iblock_offset, &
               offset_n, count_n, istart, iend)
         !$acc parallel loop collapse(2) reduction(+:vi) &
         !$acc private(xft_ij, drnorm, drnorm2rec, drnorm6rec, drnorm8rec, &
         !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l)
         do i = istart, iend
            do j = istart, iend
               call minimum_image_distance_@PBC@(a, b, c, &
                     xyz_atoms(i,1), xyz_atoms(i,2), xyz_atoms(i,3), &
                     xyz_atoms(j,1), xyz_atoms(j,2), xyz_atoms(j,3), &
                     drnorm2)
               if ((drnorm2 > 0.0_wp) .and. (drnorm2 < rcutsq))  then
                  include 'xft_potentialij.inc'
                  vi = vi + xft_ij
               end if
            end do
         end do
         !$acc end parallel loop
      end do

      ! Number of blocks with full interactions (below the diagonal
      num_block_full = localwork%pair_atom2atom_num_block_full_local(itype,itype)
      iblock_offset = localwork%pair_atom2atom_full_iblock_offset(itype,itype)

      do iblock = 1, num_block_full
         call update_tri_block_boundaries(iblock_offset+iblock, offset_n, count_n, &
               istart, iend, jstart, jend)
         !$acc parallel loop collapse(2) reduction(+:vi) &
         !$acc private(xft_ij, drnorm, drnorm2rec, drnorm6rec, drnorm8rec, &
         !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l)
         do i = istart, iend
            do j = jstart, jend
               call minimum_image_distance_@PBC@(a, b, c, &
                     xyz_atoms(i,1), xyz_atoms(i,2), xyz_atoms(i,3), &
                     xyz_atoms(j,1), xyz_atoms(j,2), xyz_atoms(j,3), &
                     drnorm2)
               if (drnorm2 < rcutsq)  then
                  include 'xft_potentialij.inc'
                  vi = vi + xft_ij
               end if
            end do
         end do
         !$acc end parallel loop
      end do
   end do
   !$acc end data
   h = vi

   call MW_timers_stop(TIMER_VAN_DER_WAALS_MELT_POTENTIAL)   
end subroutine energy_@PBC@

! ================================================================================
! Remove contribution from same molecule particles
!
subroutine melt_fix_molecule_forces_@PBC@(localwork, xft, molecules, box, ions, &
      xyz_ions, force,stress_tensor)
   implicit none
   ! Parameters
   ! ----------
   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

   ! Locals
   ! ------
   integer :: num_molecule_types, num_sites
   integer :: mol_type, isite, jsite, imol
   integer :: iion_type, jion_type, iion, jion
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz, drnorm2
   real(wp) :: xft_ij, eta_ij, B_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij
   real(wp) :: etax_ij, Bx_ij
   integer :: n_ij
   integer :: iion_type_offset, jion_type_offset
   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
   real(wp) :: scaling14
   real(wp) :: loc_stress_tensor_xx, loc_stress_tensor_yy, loc_stress_tensor_zz
   real(wp) :: loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz   
   integer :: k, l

   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   loc_stress_tensor_xx = 0.0_wp
   loc_stress_tensor_yy = 0.0_wp
   loc_stress_tensor_zz = 0.0_wp
   loc_stress_tensor_xy = 0.0_wp
   loc_stress_tensor_xz = 0.0_wp
   loc_stress_tensor_yz = 0.0_wp

   !$acc data &
   !$acc present(localwork, localwork%molecules_istart(:), localwork%molecules_iend(:), &
   !$acc         xyz_ions(:,:), ions(:), force(:,:)) &
   !$acc copy(loc_stress_tensor_xx,loc_stress_tensor_yy,loc_stress_tensor_zz, &
   !$acc           loc_stress_tensor_xy,loc_stress_tensor_xz,loc_stress_tensor_yz)   

   num_molecule_types = size(molecules,1)
   do mol_type = 1, num_molecule_types
      num_sites = molecules(mol_type)%num_sites

      do isite = 1, num_sites
         do jsite = 1, isite-1

            if ((molecules(mol_type)%halfinteracting_pairs(isite,jsite)).or. &
                (.not. molecules(mol_type)%interacting_pairs(isite, jsite))) then
               scaling14 = 1.0_wp
               if (molecules(mol_type)%halfinteracting_pairs(isite,jsite))scaling14 = 0.5_wp
               iion_type = molecules(mol_type)%sites(isite)
               jion_type = molecules(mol_type)%sites(jsite)
               iion_type_offset = ions(iion_type)%offset
               jion_type_offset = ions(jion_type)%offset
               eta_ij = xft%eta(iion_type, jion_type)
               B_ij = xft%B(iion_type, jion_type)
               n_ij = xft%n(iion_type, jion_type)
               etax_ij = xft%etax(iion_type, jion_type)
               Bx_ij = xft%Bx(iion_type, jion_type)
               C_ij = xft%C(iion_type, jion_type)
               D_ij = xft%D(iion_type, jion_type)
               damp_dd_ij = xft%damp_dd(iion_type, jion_type)
               damp_dq_ij = xft%damp_dq(iion_type, jion_type)
               !$acc parallel loop private(imol, iion, jion, dx, dy, dz, &
               !$acc drnorm2, xft_ij, drnorm, drnormrec, drnorm2rec, drnorm6rec, drnorm8rec, &
               !$acc damp_dd_sum, damp_dd_term, damp_dq_sum, damp_dq_term, k, l) &
               !$acc reduction(+:loc_stress_tensor_xx, loc_stress_tensor_yy,loc_stress_tensor_zz, &
               !$acc             loc_stress_tensor_xy,loc_stress_tensor_xz, loc_stress_tensor_yz)       
               do imol = localwork%molecules_istart(mol_type), localwork%molecules_iend(mol_type)
                  iion = imol + iion_type_offset
                  jion = imol + jion_type_offset
                  call minimum_image_displacement_@PBC@(a, b, c, &
                        xyz_ions(iion,1), xyz_ions(iion,2), xyz_ions(iion,3), &
                        xyz_ions(jion,1), xyz_ions(jion,2), xyz_ions(jion,3), &
                        dx, dy, dz, drnorm2)
                  if (drnorm2 < xft%rcutsq) then
                     ! xft_ij = force_ij(drnorm2, eta_ij, B_ij, n_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij)
                     include 'xft_forceij.inc'

                     !$acc atomic update
                     force(iion,1) = force(iion,1) - dx * xft_ij * scaling14
                     !$acc atomic update
                     force(iion,2) = force(iion,2) - dy * xft_ij * scaling14
                     !$acc atomic update
                     force(iion,3) = force(iion,3) - dz * xft_ij * scaling14

                     !$acc atomic update
                     force(jion,1) = force(jion,1) + dx * xft_ij * scaling14
                     !$acc atomic update
                     force(jion,2) = force(jion,2) + dy * xft_ij * scaling14
                     !$acc atomic update
                     force(jion,3) = force(jion,3) + dz * xft_ij * scaling14

                     loc_stress_tensor_xx = loc_stress_tensor_xx + dx * dx * xft_ij * scaling14
                     loc_stress_tensor_yy = loc_stress_tensor_yy + dy * dy * xft_ij * scaling14
                     loc_stress_tensor_zz = loc_stress_tensor_zz + dz * dz * xft_ij * scaling14
                     loc_stress_tensor_xy = loc_stress_tensor_xy + dx * dy * xft_ij * scaling14
                     loc_stress_tensor_xz = loc_stress_tensor_xz + dx * dz * xft_ij * scaling14
                     loc_stress_tensor_yz = loc_stress_tensor_yz + dy * dz * xft_ij * scaling14

                  end if
               end do
               !$acc end parallel loop
            end if
         end do
      end do
   end do
   !$acc end data
   stress_tensor(1,1) = loc_stress_tensor_xx
   stress_tensor(2,2) = loc_stress_tensor_yy
   stress_tensor(3,3) = loc_stress_tensor_zz
   stress_tensor(1,2) = loc_stress_tensor_xy
   stress_tensor(1,3) = loc_stress_tensor_xz
   stress_tensor(2,3) = loc_stress_tensor_yz

end subroutine melt_fix_molecule_forces_@PBC@

! ================================================================================
! Remove contribution from same molecule particles
!
subroutine fix_molecule_energy_@PBC@(localwork, xft, molecules, box, ions, &
      xyz_ions, h)
   implicit none
   ! Parameters
   ! ----------
   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(:) !< melt particle parameters
   real(wp), intent(in) :: xyz_ions(:,:) !< melt particles coordinates
   real(wp), intent(inout) :: h !< potential on melt particles

   ! Locals
   ! ------
   integer :: num_molecule_types, num_sites
   integer :: mol_type, isite, jsite, imol
   integer :: iion_type, jion_type, iion, jion
   integer :: n_ij
   real(wp) :: a, b, c
   real(wp) :: drnorm2, vi
   real(wp) :: xft_ij, eta_ij, B_ij, C_ij, D_ij, damp_dd_ij, damp_dq_ij
   real(wp) :: etax_ij, Bx_ij
   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
   real(wp) :: scaling14
   integer :: k, l


   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   h = 0.0_wp
   vi = 0.0_wp
   !$acc data copy(vi) &
   !$acc present(localwork, localwork%molecules_istart(:), localwork%molecules_iend(:), &
   !$acc         xyz_ions(:,:), ions(:))

   num_molecule_types = size(molecules,1)
   do mol_type = 1, num_molecule_types
      num_sites = molecules(mol_type)%num_sites

      do isite = 1, num_sites
         do jsite = 1, isite-1

            if ((molecules(mol_type)%halfinteracting_pairs(isite,jsite)).or. &
                (.not. molecules(mol_type)%interacting_pairs(isite, jsite))) then
               scaling14 = 1.0_wp
               if (molecules(mol_type)%halfinteracting_pairs(isite,jsite))scaling14 = 0.5_wp

               iion_type = molecules(mol_type)%sites(isite)
               jion_type = molecules(mol_type)%sites(jsite)
               eta_ij = xft%eta(iion_type, jion_type)
               B_ij = xft%B(iion_type, jion_type)
               n_ij = xft%n(iion_type, jion_type)
               etax_ij = xft%etax(iion_type, jion_type)
               Bx_ij = xft%Bx(iion_type, jion_type)
               C_ij = xft%C(iion_type, jion_type)
               D_ij = xft%D(iion_type, jion_type)
               damp_dd_ij = xft%damp_dd(iion_type, jion_type)
               damp_dq_ij = xft%damp_dq(iion_type, jion_type)
               !$acc parallel loop private(imol, iion, jion, drnorm2, xft_ij) present(vi) &
               !$acc reduction(+:vi)
               do imol = localwork%molecules_istart(mol_type), localwork%molecules_iend(mol_type)
                  iion = imol + ions(iion_type)%offset
                  jion = imol + ions(jion_type)%offset

                  call minimum_image_distance_@PBC@(a, b, c, &
                        xyz_ions(iion,1), xyz_ions(iion,2), xyz_ions(iion,3), &
                        xyz_ions(jion,1), xyz_ions(jion,2), xyz_ions(jion,3), &
                        drnorm2)
                  if (drnorm2 < xft%rcutsq) then
                     include 'xft_potentialij.inc'
                     vi = vi + xft_ij * scaling14
                  end if
               end do
               !$acc end parallel loop
            end if
         end do
      end do
   end do
   !$acc end data
   h = - vi
end subroutine fix_molecule_energy_@PBC@
