! ================================================================================
! Remove contribution from same molecule particles to the electric fields due to the charge
!
subroutine fix_molecule_gradmumelt_electricfield_@PBC@(localwork, molecules, box, &
      ions, xyz_ions, gradmu_efield)
   implicit none
   ! Parameters in
   ! ----------
   type(MW_localwork_t), intent(in)    :: localwork
   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(:) !< ion types parameters
   real(wp),             intent(in)    :: xyz_ions(:,:) !< melt particles coordinates

   ! Parameters out
   ! ----------
   real(wp),             intent(inout) :: gradmu_efield(:,:) !< electric field on melt particles

   ! Locals
   ! ------
   integer :: num_molecule_types, num_sites, num_ions
   integer :: mol_type, isite, jsite, imol
   integer :: iion_type, jion_type, iion, jion, iionx, iiony, iionz, jionx, jiony, jionz
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz
   real(wp) :: drnorm, drnorm2
   real(wp) :: drnorm3rec, drnorm5rec
   real(wp) :: scaling14

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

   !$acc data &
   !$acc present(localwork, localwork%molecules_istart(:), localwork%molecules_iend(:), &
   !$acc         xyz_ions(:,:), ions(:), gradmu_efield(:,:))

   num_ions = size(gradmu_efield,1)/3
   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)

               !$acc parallel loop private(imol, iion, jion, jionx, iionx, jiony, iiony, &
               !$acc                       jionz, iionz, dx, dy, dz, drnorm2, drnorm, &
               !$acc                       drnorm3rec, drnorm5rec)
               do imol = localwork%molecules_istart(mol_type), localwork%molecules_iend(mol_type)

                  iion  = imol + ions(iion_type)%offset
                  iionx = iion
                  iiony = iion + num_ions
                  iionz = iion + num_ions*2

                  jion  = imol + ions(jion_type)%offset
                  jionx = jion
                  jiony = jion + num_ions
                  jionz = jion + num_ions*2

                  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)
                  drnorm = sqrt(drnorm2)
                  drnorm3rec = 1.0_wp/(drnorm*drnorm2)
                  drnorm5rec = drnorm3rec*1.0_wp/(drnorm2)

                  gradmu_efield(jionx,iionx) = scaling14 * (3.0_wp * dx * dx * drnorm5rec - drnorm3rec)
                  gradmu_efield(jiony,iionx) = scaling14 * 3.0_wp * dy * dx * drnorm5rec
                  gradmu_efield(jionz,iionx) = scaling14 * 3.0_wp * dz * dx * drnorm5rec

                  gradmu_efield(jiony,iiony) = scaling14 * (3.0_wp * dy * dy * drnorm5rec - drnorm3rec)
                  gradmu_efield(jionz,iiony) = scaling14 * 3.0_wp * dz * dy * drnorm5rec

                  gradmu_efield(jionz,iionz) = scaling14 * (3.0_wp * dz * dz * drnorm5rec - drnorm3rec)

               end do
               !$acc end parallel loop
            end if
         end do
      end do
   end do
   !$acc end data
end subroutine fix_molecule_gradmumelt_electricfield_@PBC@

! ================================================================================
! Remove contribution from same molecule particles to the electric fields due to the charge
!
subroutine fix_molecule_qmelt2mumelt_electricfield_@PBC@(localwork, molecules, box, &
      ions, xyz_ions, efield, tt)
   implicit none
   ! Parameters in
   ! ----------
   type(MW_localwork_t), intent(in)    :: localwork
   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(:) !< ion types parameters
   real(wp),             intent(in)    :: xyz_ions(:,:) !< melt particles coordinates
   type(MW_damping_t),   intent(in)    :: tt  !< Damping parameters

   ! Parameters out
   ! ----------
   real(wp),             intent(inout) :: efield(:,:) !< electric field on melt particles

   ! Locals
   ! ------
   integer :: num_molecule_types, num_sites
   integer :: mol_type, isite, jsite, imol
   integer :: iion_type, jion_type, iion, jion
   integer :: kk
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz, drnorm2, drnorm,drnorm3rec
   real(wp) :: qi, qj
   real(wp) :: xf, factorial
   real(wp) :: dampsumfi, dampexpi, dampfunci
   real(wp) :: dampsumfj, dampexpj, dampfuncj
   real(wp) :: scaling14

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

   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)

               qi = ions(iion_type)%charge
               qj = ions(jion_type)%charge
               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_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)
                  drnorm = sqrt(drnorm2)
                  drnorm3rec = 1.0_wp/(drnorm*drnorm2)

                  dampsumfi = 1.0_wp
                  xf = 1.0_wp
                  factorial = 1.0_wp
                  do kk = 1, tt%order(jion_type,iion_type)
                     xf = xf*tt%b(jion_type,iion_type)*drnorm
                     factorial = factorial*float(kk)
                     dampsumfi = dampsumfi + (xf/factorial)
                  enddo
                  dampexpi = dexp(-tt%b(jion_type,iion_type)*drnorm)
                  dampfunci = -dampsumfi*dampexpi*tt%c(jion_type,iion_type)

                  efield(iion,1) = efield(iion,1) + qj*dx*(1.0_wp + dampfunci)*drnorm3rec * scaling14
                  efield(iion,2) = efield(iion,2) + qj*dy*(1.0_wp + dampfunci)*drnorm3rec * scaling14
                  efield(iion,3) = efield(iion,3) + qj*dz*(1.0_wp + dampfunci)*drnorm3rec * scaling14

                  dampsumfj = 1.0_wp
                  xf = 1.0_wp
                  factorial = 1.0_wp
                  do kk = 1,tt%order(iion_type,jion_type)
                     xf = xf*tt%b(iion_type,jion_type)*drnorm
                     factorial = factorial*float(kk)
                     dampsumfj = dampsumfj + (xf/factorial)
                  enddo
                  dampexpj = dexp(-tt%b(iion_type,jion_type)*drnorm)
                  dampfuncj = -dampsumfj*dampexpj*tt%c(iion_type,jion_type)

                  efield(jion,1) = efield(jion,1) - qi*dx*(1.0_wp + dampfuncj)*drnorm3rec * scaling14
                  efield(jion,2) = efield(jion,2) - qi*dy*(1.0_wp + dampfuncj)*drnorm3rec * scaling14
                  efield(jion,3) = efield(jion,3) - qi*dz*(1.0_wp + dampfuncj)*drnorm3rec * scaling14

               end do
            end if
         end do
      end do
   end do
end subroutine fix_molecule_qmelt2mumelt_electricfield_@PBC@

! ================================================================================
! Remove contribution from same molecule particles to the electric fields due to the charge
!
subroutine fix_molecule_mumelt2mumelt_electricfield_@PBC@(localwork, molecules, box, &
      ions, xyz_ions, efield, dipoles)
   implicit none
   ! Parameters in
   ! ----------
   type(MW_localwork_t), intent(in)    :: localwork
   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(:) !< ion types parameters
   real(wp),             intent(in)    :: xyz_ions(:,:) !< melt particles coordinates
   real(wp),             intent(in)    :: dipoles(:,:) !< ions dipoles

   ! Parameters out
   ! ----------
   real(wp),             intent(inout) :: efield(:,:) !< electric field on melt particles

   ! 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) :: muix, muiy, muiz
   real(wp) :: mujx, mujy, mujz
   real(wp) :: muidotrij, mujdotrij
   real(wp) :: dx, dy, dz
   real(wp) :: drnorm, drnorm2
   real(wp) :: drnorm3rec, drnorm5rec
   real(wp) :: scaling14

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

   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)

               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_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)
                  drnorm = sqrt(drnorm2)
                  drnorm3rec = 1.0_wp/(drnorm*drnorm2)
                  drnorm5rec = drnorm3rec*1.0_wp/(drnorm2)

                  muix = dipoles(iion,1)
                  muiy = dipoles(iion,2)
                  muiz = dipoles(iion,3)

                  mujx = dipoles(jion,1)
                  mujy = dipoles(jion,2)
                  mujz = dipoles(jion,3)

                  muidotrij = -muix*dx - muiy*dy - muiz*dz
                  mujdotrij = -mujx*dx - mujy*dy - mujz*dz

                  efield(iion,1) = efield(iion,1) + (mujx*drnorm3rec + mujdotrij*3.0_wp*dx*drnorm5rec) * scaling14
                  efield(iion,2) = efield(iion,2) + (mujy*drnorm3rec + mujdotrij*3.0_wp*dy*drnorm5rec) * scaling14
                  efield(iion,3) = efield(iion,3) + (mujz*drnorm3rec + mujdotrij*3.0_wp*dz*drnorm5rec) * scaling14

                  efield(jion,1) = efield(jion,1) + (muix*drnorm3rec + muidotrij*3.0_wp*dx*drnorm5rec) * scaling14
                  efield(jion,2) = efield(jion,2) + (muiy*drnorm3rec + muidotrij*3.0_wp*dy*drnorm5rec) * scaling14
                  efield(jion,3) = efield(jion,3) + (muiz*drnorm3rec + muidotrij*3.0_wp*dz*drnorm5rec) * scaling14

               end do
            end if
         end do
      end do
   end do
end subroutine fix_molecule_mumelt2mumelt_electricfield_@PBC@

! ================================================================================
! Remove contribution from same molecule particles to the forces
!
subroutine fix_molecule_melt_forces_@PBC@(localwork, molecules, box, &
      ions, xyz_ions, force,stress_tensor)
   implicit none
   ! Parameters in
   ! ----------
   type(MW_localwork_t), intent(in)    :: localwork
   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(:) !< ion types parameters
   real(wp),             intent(in)    :: xyz_ions(:,:) !< melt particles coordinates

   ! Parameters in
   ! ----------
   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, drnorm
   real(wp) :: qi, qj,fij
   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

   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

   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)

               qi = ions(iion_type)%charge
               qj = ions(jion_type)%charge
               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_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)
                  drnorm = sqrt(drnorm2)

                  fij=qi*qj/(drnorm2*drnorm)*scaling14

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

                  force(iion,1) = force(iion,1) + dx * fij
                  force(iion,2) = force(iion,2) + dy * fij
                  force(iion,3) = force(iion,3) + dz * fij

                  force(jion,1) = force(jion,1) - dx * fij
                  force(jion,2) = force(jion,2) - dy * fij
                  force(jion,3) = force(jion,3) - dz * fij

               end do
            end if
         end do
      end do
   end do

   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 fix_molecule_melt_forces_@PBC@

! ================================================================================
! Remove contribution from same molecule particles to the forces (charge-dipole and dip-dip)
!
subroutine fix_molecule_pim_melt_forces_@PBC@(localwork, molecules, box, &
      ions, xyz_ions, force, stress_tensor, dipoles, tt)
   implicit none
   ! Parameters
   ! ----------
   type(MW_localwork_t), intent(in)    :: localwork
   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(:) !< ion types parameters
   real(wp),             intent(in)    :: xyz_ions(:,:) !< melt particles coordinates
   type(MW_damping_t),   intent(in)    :: tt  !< Damping parameters
   real(wp),             intent(in)    :: dipoles(:,:) !< ions dipoles

   ! Parameters
   ! ----------
   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
   integer :: orderij, orderji
   integer :: kk
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz
   real(wp) :: drnorm, drnorm2
   real(wp) :: drnormrec, drnorm2rec, drnorm3rec, drnorm5rec, drnorm7rec
   real(wp) :: muix, muiy, muiz
   real(wp) :: mujx, mujy, mujz
   real(wp) :: qjdotmuix, qjdotmuiy, qjdotmuiz
   real(wp) :: minusqidotmujx, minusqidotmujy, minusqidotmujz
   real(wp) :: muidotrij, mujdotrij
   real(wp) :: qmuengij, qmuengji
   real(wp) :: ftqmu_ijx, ftqmu_ijy, ftqmu_ijz
   real(wp) :: ftqmu_jix, ftqmu_jiy, ftqmu_jiz
   real(wp) :: qi, qj,fij,fijx,fijy,fijz
   real(wp) :: xf, factorial
   real(wp) :: dampsumfi, dampexpi, dampfunci, dampfuncdiffi, diprfunci
   real(wp) :: dampsumfj, dampexpj, dampfuncj, dampfuncdiffj, diprfuncj
   real(wp) :: bjidrnorm, bijdrnorm
   real(wp) :: txxx, txxy, txyy, txxz, txzz, tyyy, tyyz, tyzz, tzzz, txyz
   real(wp) :: mujdotTdotmuix, mujdotTdotmuiy, mujdotTdotmuiz
   real(wp) :: bij, cij, bji, cji
   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

   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

   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)

               qi = ions(iion_type)%charge
               qj = ions(jion_type)%charge
               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_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)
                  drnorm = sqrt(drnorm2)
                  drnormrec = 1.0_wp/(drnorm)
                  drnorm2rec = 1.0_wp/(drnorm2)
                  drnorm3rec = drnormrec*1.0_wp/(drnorm2)
                  drnorm5rec = drnorm3rec*1.0_wp/(drnorm2)
                  drnorm7rec = drnorm5rec*1.0_wp/(drnorm2)

                  fij = qi * qj * drnorm3rec * scaling14

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

                  force(iion,1) = force(iion,1) + dx * fij
                  force(iion,2) = force(iion,2) + dy * fij
                  force(iion,3) = force(iion,3) + dz * fij

                  force(jion,1) = force(jion,1) - dx * fij
                  force(jion,2) = force(jion,2) - dy * fij
                  force(jion,3) = force(jion,3) - dz * fij

                  muix = dipoles(iion,1)
                  muiy = dipoles(iion,2)
                  muiz = dipoles(iion,3)

                  mujx = dipoles(jion,1)
                  mujy = dipoles(jion,2)
                  mujz = dipoles(jion,3)

                  bij = tt%b(iion_type,jion_type)
                  orderij = tt%order(iion_type,jion_type)
                  cij = tt%c(iion_type,jion_type)
                  bji = tt%b(jion_type,iion_type)
                  orderji = tt%order(jion_type,iion_type)
                  cji = tt%c(jion_type,iion_type)

                  muidotrij = -muix*dx - muiy*dy - muiz*dz
                  mujdotrij = -mujx*dx - mujy*dy - mujz*dz

                  qmuengij = (qj*muidotrij)*drnorm3rec  !chgdipengij
                  qmuengji = -(qi*mujdotrij)*drnorm3rec !chgdipengji

                  qjdotmuix = qj*muix  ! qdotmuxij in pimaim
                  qjdotmuiy = qj*muiy  ! qdotmuyij in pimaim
                  qjdotmuiz = qj*muiz  ! qdotmuzij in pimaim

                  minusqidotmujx = -qi*mujx ! qdotmuxji in pimaim
                  minusqidotmujy = -qi*mujy ! qdotmuyji in pimaim
                  minusqidotmujz = -qi*mujz ! qdotmuzji in pimaim

                  dampsumfi = 1.0_wp
                  xf = 1.0_wp
                  factorial = 1.0_wp
                  bjidrnorm = bji*drnorm
                  do kk = 1, orderji
                     xf = xf*bji*drnorm
                     factorial = factorial*float(kk)
                     dampsumfi = dampsumfi + (xf/factorial)
                  enddo
                  dampexpi = dexp(-bji*drnorm)
                  dampfunci = -dampsumfi*dampexpi*cji
                  dampfuncdiffi = bji*dampexpi*cji*((bjidrnorm)**orderji)/factorial
                  diprfunci = qmuengij*drnormrec*(-3.0_wp*dampfunci*drnormrec + dampfuncdiffi)

                  dampsumfj = 1.0_wp
                  xf = 1.0_wp
                  factorial = 1.0_wp
                  bijdrnorm = bij*drnorm
                  do kk = 1, orderij
                     xf = xf*bij*drnorm
                     factorial = factorial*float(kk)
                     dampsumfj = dampsumfj + (xf/factorial)
                  enddo
                  dampexpj = dexp(-bij*drnorm)
                  dampfuncj = -dampsumfj*dampexpj*cij
                  dampfuncdiffj = bij*dampexpj*cij*((bijdrnorm)**orderij)/factorial
                  diprfuncj = -qmuengji*drnormrec*(-3.0_wp*dampfuncj*drnormrec + dampfuncdiffj)

                  ftqmu_ijx = -qjdotmuix*(1.0_wp + dampfunci)*drnorm3rec &
                       -3.0_wp*dx*qmuengij*drnorm2rec &
                       +dx*diprfunci
                  ftqmu_jix = -minusqidotmujx*(1.0_wp + dampfuncj)*drnorm3rec &
                       -3.0_wp*dx*qmuengji*drnorm2rec &
                       -dx*diprfuncj
                  ftqmu_ijy = -qjdotmuiy*(1.0_wp + dampfunci)*drnorm3rec &
                       -3.0_wp*dy*qmuengij*drnorm2rec &
                       +dy*diprfunci
                  ftqmu_jiy = -minusqidotmujy*(1.0_wp + dampfuncj)*drnorm3rec &
                       -3.0_wp*dy*qmuengji*drnorm2rec &
                       -dy*diprfuncj
                  ftqmu_ijz = -qjdotmuiz*(1.0_wp + dampfunci)*drnorm3rec &
                       -3.0_wp*dz*qmuengij*drnorm2rec &
                       +dz*diprfunci
                  ftqmu_jiz = -minusqidotmujz*(1.0_wp + dampfuncj)*drnorm3rec &
                       -3.0_wp*dz*qmuengji*drnorm2rec &
                       -dz*diprfuncj

                  force(iion,1) = force(iion,1) + (ftqmu_ijx + ftqmu_jix) * scaling14
                  force(iion,2) = force(iion,2) + (ftqmu_ijy + ftqmu_jiy) * scaling14
                  force(iion,3) = force(iion,3) + (ftqmu_ijz + ftqmu_jiz) * scaling14

                  force(jion,1) = force(jion,1) - (ftqmu_ijx + ftqmu_jix) * scaling14
                  force(jion,2) = force(jion,2) - (ftqmu_ijy + ftqmu_jiy) * scaling14
                  force(jion,3) = force(jion,3) - (ftqmu_ijz + ftqmu_jiz) * scaling14

                  fijx = (ftqmu_ijx + ftqmu_jix) * scaling14
                  fijy = (ftqmu_ijy + ftqmu_jiy) * scaling14
                  fijz = (ftqmu_ijz + ftqmu_jiz) * scaling14


                  loc_stress_tensor_xx = loc_stress_tensor_xx - dx * fijx
                  loc_stress_tensor_yy = loc_stress_tensor_yy - dy * fijy
                  loc_stress_tensor_zz = loc_stress_tensor_zz - dz * fijz
                  loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * dx * fijy
                  loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * dy * fijx
                  loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * dx * fijz
                  loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * dz * fijx
                  loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * dy * fijz
                  loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * dz * fijy

                  txxx = -(15.0_wp*dx**3.0    - 9.0_wp*dx*drnorm2)*drnorm7rec
                  tyyy = -(15.0_wp*dy**3.0    - 9.0_wp*dy*drnorm2)*drnorm7rec
                  tzzz = -(15.0_wp*dz**3.0    - 9.0_wp*dz*drnorm2)*drnorm7rec
                  txxy = -(15.0_wp*dy*dx**2.0 - 3.0_wp*dy*drnorm2)*drnorm7rec
                  txyy = -(15.0_wp*dx*dy**2.0 - 3.0_wp*dx*drnorm2)*drnorm7rec
                  txxz = -(15.0_wp*dz*dx**2.0 - 3.0_wp*dz*drnorm2)*drnorm7rec
                  txzz = -(15.0_wp*dx*dz**2.0 - 3.0_wp*dx*drnorm2)*drnorm7rec
                  tyyz = -(15.0_wp*dz*dy**2.0 - 3.0_wp*dz*drnorm2)*drnorm7rec
                  tyzz = -(15.0_wp*dy*dz**2.0 - 3.0_wp*dy*drnorm2)*drnorm7rec
                  txyz = -(15.0_wp*dx*dy*dz                     )*drnorm7rec

                  mujdotTdotmuix = (mujx*(muix*txxx + muiy*txxy + muiz*txxz)) &  !fmumux in pimaim
                       +(mujy*(muix*txxy + muiy*txyy + muiz*txyz)) &
                       +(mujz*(muix*txxz + muiy*txyz + muiz*txzz))
                  mujdotTdotmuiy = (mujx*(muix*txxy + muiy*txyy + muiz*txyz)) &  !fmumuy in pimaim
                       +(mujy*(muix*txyy + muiy*tyyy + muiz*tyyz)) &
                       +(mujz*(muix*txyz + muiy*tyyz + muiz*tyzz))
                  mujdotTdotmuiz = (mujx*(muix*txxz + muiy*txyz + muiz*txzz)) &  !fmumuz in pimaim
                       +(mujy*(muix*txyz + muiy*tyyz + muiz*tyzz)) &
                       +(mujz*(muix*txzz + muiy*tyzz + muiz*tzzz))

                  force(iion,1) = force(iion,1) + mujdotTdotmuix * scaling14
                  force(iion,2) = force(iion,2) + mujdotTdotmuiy * scaling14
                  force(iion,3) = force(iion,3) + mujdotTdotmuiz * scaling14
                  force(jion,1) = force(jion,1) - mujdotTdotmuix * scaling14
                  force(jion,2) = force(jion,2) - mujdotTdotmuiy * scaling14
                  force(jion,3) = force(jion,3) - mujdotTdotmuiz * scaling14

                  loc_stress_tensor_xx = loc_stress_tensor_xx - dx * mujdotTdotmuix * scaling14
                  loc_stress_tensor_yy = loc_stress_tensor_yy - dy * mujdotTdotmuiy * scaling14
                  loc_stress_tensor_zz = loc_stress_tensor_zz - dz * mujdotTdotmuiz * scaling14
                  loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * dx * mujdotTdotmuiy * scaling14
                  loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * dy * mujdotTdotmuix * scaling14
                  loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * dx * mujdotTdotmuiz * scaling14
                  loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * dz * mujdotTdotmuix * scaling14
                  loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * dy * mujdotTdotmuiz * scaling14
                  loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * dz * mujdotTdotmuiy * scaling14

               end do
            end if
         end do
      end do
   end do
   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 fix_molecule_pim_melt_forces_@PBC@

! ================================================================================
! Remove contribution from same molecule particles to the energy
!
subroutine fix_molecule_energy_@PBC@(localwork, molecules, box, &
      ions, xyz_ions, h)
   implicit none
   ! Parameters in
   ! ----------
   type(MW_localwork_t), intent(in)    :: localwork
   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(:) !< ion types parameters
   real(wp),             intent(in)    :: xyz_ions(:,:) !< melt particles coordinates

   ! Parameters out
   ! --------------
   real(wp),             intent(inout) :: h !< energy on melt particles

   ! 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) :: drnorm2, drnorm
   real(wp) :: qi, qj
   real(wp) :: vi
   real(wp) :: scaling14

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

   vi = 0.0_wp

   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)

               qi = ions(iion_type)%charge
               qj = ions(jion_type)%charge

               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)
                  drnorm = sqrt(drnorm2)
                  vi = vi + scaling14 * (qi * qj) / drnorm
               end do
            end if
         end do
      end do
   end do
   h = -vi

end subroutine fix_molecule_energy_@PBC@

subroutine fix_molecule_pim_energy_@PBC@(localwork, molecules, box, &
      ions, xyz_ions, dipoles, tt, h)
   implicit none
   ! Parameters in
   ! ----------
   type(MW_localwork_t), intent(in)    :: localwork
   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(:) !< ion types parameters
   real(wp),             intent(in)    :: xyz_ions(:,:) !< melt particles coordinates
   type(MW_damping_t),   intent(in)    :: tt  !< Damping parameters
   real(wp),             intent(in)    :: dipoles(:,:) !< ions dipoles

   ! Parameters in
   ! ----------
   real(wp),             intent(inout) :: h !< energy on melt particles

   ! Locals
   ! ------
   integer :: num_molecule_types, num_sites
   integer :: mol_type, isite, jsite, imol
   integer :: iion_type, jion_type, iion, jion
   integer :: kk, orderij, orderji
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz
   real(wp) :: drnorm2, drnorm, drnormrec, drnorm2rec
   real(wp) :: drnorm3rec
   real(wp) :: muix, muiy, muiz
   real(wp) :: mujx, mujy, mujz
   real(wp) :: muidotrij, mujdotrij
   real(wp) :: qmuengij, qmuengji
   real(wp) :: muidotSx, muidotSy, muidotSz, muidotSdotmuj
   real(wp) :: sxx, sxy, sxz, syy, syz, szz
   real(wp) :: bij, bji, cij, cji
   real(wp) :: xf, factorial
   real(wp) :: dampsumfi, dampexpi, dampfunci
   real(wp) :: dampsumfj, dampexpj, dampfuncj
   real(wp) :: bjidrnorm, bijdrnorm
   real(wp) :: qi, qj
   real(wp) :: vi
   real(wp) :: scaling14

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

   vi = 0.0_wp

   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)

               qi = ions(iion_type)%charge
               qj = ions(jion_type)%charge

               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_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)
                  drnorm = sqrt(drnorm2)
                  drnormrec = 1.0_wp/drnorm
                  drnorm2rec = drnormrec*drnormrec
                  drnorm3rec = drnormrec*drnorm2rec

                  muix = dipoles(iion,1)
                  muiy = dipoles(iion,2)
                  muiz = dipoles(iion,3)

                  mujx = dipoles(jion,1)
                  mujy = dipoles(jion,2)
                  mujz = dipoles(jion,3)

                  bij = tt%b(iion_type,jion_type)
                  orderij = tt%order(iion_type,jion_type)
                  cij = tt%c(iion_type,jion_type)
                  bji = tt%b(jion_type,iion_type)
                  orderji = tt%order(jion_type,iion_type)
                  cji = tt%c(jion_type,iion_type)

                  muidotrij = -muix*dx - muiy*dy - muiz*dz ! xmuidotrij in pimaim Warning sens vecteur dr
                  mujdotrij = -mujx*dx - mujy*dy - mujz*dz ! xmujdotrij in pimaim

                  qmuengij = (qj*muidotrij)*drnorm3rec  !chgdipengij
                  qmuengji = -(qi*mujdotrij)*drnorm3rec !chgdipengji

                  dampsumfi = 1.0_wp
                  xf = 1.0_wp
                  factorial = 1.0_wp
                  bjidrnorm = bji*drnorm
                  do kk = 1, orderji
                     xf = xf*bjidrnorm
                     factorial = factorial*float(kk)
                     dampsumfi = dampsumfi + (xf/factorial)
                  enddo
                  dampexpi = dexp(-bji*drnorm)
                  dampfunci = -dampsumfi*dampexpi*cji*drnorm3rec

                  dampsumfj = 1.0_wp
                  xf = 1.0_wp
                  factorial = 1.0_wp
                  bijdrnorm = bij*drnorm
                  do kk = 1,orderij
                     xf = xf*bijdrnorm
                     factorial = factorial*float(kk)
                     dampsumfj = dampsumfj + (xf/factorial)
                  enddo
                  dampexpj = dexp(-bij*drnorm)
                  dampfuncj = -dampsumfj*dampexpj*cij*drnorm3rec

                  sxx = 1.0_wp - 3.0_wp*dx*dx*drnorm2rec ! sxx in pimaim
                  syy = 1.0_wp - 3.0_wp*dy*dy*drnorm2rec
                  szz = 1.0_wp - 3.0_wp*dz*dz*drnorm2rec
                  sxy = -3.0_wp*dx*dy*drnorm2rec
                  sxz = -3.0_wp*dx*dz*drnorm2rec
                  syz = -3.0_wp*dy*dz*drnorm2rec

                  muidotSx = muix*sxx + muiy*sxy + muiz*sxz  ! xmuidotT in pimaim
                  muidotSy = muix*sxy + muiy*syy + muiz*syz  ! ymuidotT in pimaim
                  muidotSz = muix*sxz + muiy*syz + muiz*szz  ! zmuidotT in pimaim

                  muidotSdotmuj = muidotSx*mujx + muidotSy*mujy + muidotSz*mujz ! dipdipeng in pimaim (1st occurence)

                  vi = vi + scaling14*((qi*qj)/drnorm - qmuengij - qmuengji &
                       -qj*muidotrij*dampfunci + qi*mujdotrij*dampfuncj &
                       +muidotSdotmuj*drnorm3rec)
               end do
            end if
         end do
      end do
   end do
   h = -vi

end subroutine fix_molecule_pim_energy_@PBC@
