! ================================================================================
!> Compute the forces due to harmonic bond potential
subroutine forces_@PBC@(localwork, box, molecules, ions, xyz_ions, force,stress_tensor)
   implicit none
   ! Parameters
   ! ----------
   type(MW_localwork_t), intent(in) :: localwork
   type(MW_box_t), intent(in) :: box
   type(MW_molecule_t), intent(in) :: molecules(:)
   type(MW_ion_t), intent(in) :: ions(:)
   real(wp), intent(in) :: xyz_ions(:,:)
   real(wp), intent(inout) :: force(:,:)
   real(wp), intent(inout) :: stress_tensor(:,:)

   ! Locals
   ! ------
   integer :: num_molecule_types, imoltype, imol
   integer :: num_harmonic_bonds, ibond
   integer :: iasite,ibsite,iatype, ibtype, ia, ib
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz, drnorm2, drnorm
   real(wp) :: k, b0, fab
   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   

   call MW_timers_start(TIMER_INTRA_MELT_FORCES)   

   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)

   !$acc data &
   !$acc present(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)

   do imoltype = 1, num_molecule_types
      num_harmonic_bonds = molecules(imoltype)%num_harmonic_bonds
      if (num_harmonic_bonds > 0) then

         do ibond = 1, num_harmonic_bonds
            ! bond parameters
            k = molecules(imoltype)%harmonic_bonds_strength(ibond)
            b0 = molecules(imoltype)%harmonic_bonds_length(ibond)
            
            iasite = molecules(imoltype)%harmonic_bonds_sites(1,ibond)
            ibsite = molecules(imoltype)%harmonic_bonds_sites(2,ibond)

            iatype=molecules(imoltype)%sites(iasite)
            ibtype=molecules(imoltype)%sites(ibsite)

            !$acc parallel loop private(imol, ia, ib, dx, dy, dz, drnorm2, drnorm, fab) &
            !$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(imoltype), localwork%molecules_iend(imoltype)

               ia = ions(iatype)%offset + imol
               ib = ions(ibtype)%offset + imol

               call minimum_image_displacement_@PBC@(a, b, c, &
                     xyz_ions(ia,1), xyz_ions(ia,2), xyz_ions(ia,3), &
                     xyz_ions(ib,1), xyz_ions(ib,2), xyz_ions(ib,3), &
                     dx, dy, dz, drnorm2)

               drnorm = sqrt(drnorm2)
               fab = -2.0_wp * k * (drnorm - b0) / drnorm

               !$acc atomic update
               force(ib,1) = force(ib,1) + dx * fab
               !$acc atomic update
               force(ib,2) = force(ib,2) + dy * fab
               !$acc atomic update
               force(ib,3) = force(ib,3) + dz * fab

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

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

            end do
            !$acc end parallel loop
         end do
      end if
   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_INTRA_MELT_FORCES)
end subroutine forces_@PBC@

! ================================================================================
!> Compute the forces due to harmonic bond potential
subroutine energy_@PBC@(localwork, box, molecules, ions, xyz_ions, h)
   implicit none
   ! Parameters
   ! ----------
   type(MW_localwork_t), intent(in) :: localwork
   type(MW_box_t), intent(in) :: box
   type(MW_molecule_t), intent(in) :: molecules(:)
   type(MW_ion_t), intent(in) :: ions(:)
   real(wp), intent(in) :: xyz_ions(:,:)
   real(wp), intent(inout) :: h

   ! Locals
   ! ------
   integer :: num_molecule_types, imoltype, imol
   integer :: num_harmonic_bonds, ibond
   integer :: iatype, ibtype, ia, ib
   integer :: iasite,ibsite
   real(wp) :: a, b, c
   real(wp) :: drnorm2, drnorm
   real(wp) :: k, b0, Uab

   call MW_timers_start(TIMER_INTRA_MELT_POTENTIAL)

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

   num_molecule_types = size(molecules,1)

   do imoltype = 1, num_molecule_types
      num_harmonic_bonds = molecules(imoltype)%num_harmonic_bonds
      if (num_harmonic_bonds > 0) then
         do imol = localwork%molecules_istart(imoltype), localwork%molecules_iend(imoltype)
            do ibond = 1, num_harmonic_bonds
               ! bond parameters
               k = molecules(imoltype)%harmonic_bonds_strength(ibond)
               b0 = molecules(imoltype)%harmonic_bonds_length(ibond)

               iasite = molecules(imoltype)%harmonic_bonds_sites(1,ibond)
               ibsite = molecules(imoltype)%harmonic_bonds_sites(2,ibond)

               iatype=molecules(imoltype)%sites(iasite)
               ibtype=molecules(imoltype)%sites(ibsite)

               ia = ions(iatype)%offset + imol
               ib = ions(ibtype)%offset + imol

               call minimum_image_distance_@PBC@(a, b, c, &
                     xyz_ions(ia,1), xyz_ions(ia,2), xyz_ions(ia,3), &
                     xyz_ions(ib,1), xyz_ions(ib,2), xyz_ions(ib,3), &
                     drnorm2)
               drnorm = sqrt(drnorm2)
               Uab = k * (drnorm - b0) * (drnorm - b0)
               h = h + Uab
            end do
         end do
      end if
   end do

   call MW_timers_stop(TIMER_INTRA_MELT_POTENTIAL)

end subroutine energy_@PBC@
