! ================================================================================
!> Compute the forces due to dihedral 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_dihedrals, idihedral
   integer :: iatype, ibtype, ictype, idtype 
   integer :: iasite, ibsite, icsite, idsite 
   integer :: ia, ib, ic, id
   real(wp) :: a, b, c
   real(wp) :: dxab, dyab, dzab, drnormab2
   real(wp) :: dxbc, dybc, dzbc, drnormbc2
   real(wp) :: dxcd, dycd, dzcd, drnormcd2
   real(wp), dimension(3) :: rabXrbc,rbcXrcd
   real(wp) :: normrabXrbc2,normrbcXrcd2
   real(wp) :: normrabXrbc,normrbcXrcd
   real(wp) :: rabXrbcdotrbcXrcd
   real(wp) :: v1,v2,v3,v4
   real(wp) :: phi
   real(wp) :: cos_phi,sin_phi,sin_2phi,sin_3phi,sin_4phi
   real(wp) :: dudphi
   real(wp) :: prefactor1,prefactor2,prefactor3,prefactor4
   real(wp) :: dxabbc,dxbccd,dxabcd,dxabab,dxbcbc,dxcdcd
   real(wp) :: dyabbc,dybccd,dyabcd,dyabab,dybcbc,dycdcd
   real(wp) :: dzabbc,dzbccd,dzabcd,dzabab,dzbcbc,dzcdcd

   call MW_timers_start(TIMER_INTRA_MELT_FORCES)

   num_molecule_types = size(molecules,1)

   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(:), force(:,:), stress_tensor(:,:))  


   do imoltype = 1, num_molecule_types
      num_dihedrals = molecules(imoltype)%num_dihedrals
      if (num_dihedrals > 0) then
         do idihedral = 1, num_dihedrals
            ! angle parameters
            v1 = molecules(imoltype)%dihedrals_v1(idihedral)
            v2 = molecules(imoltype)%dihedrals_v2(idihedral)
            v3 = molecules(imoltype)%dihedrals_v3(idihedral)
            v4 = molecules(imoltype)%dihedrals_v4(idihedral)

            iasite = molecules(imoltype)%dihedrals_sites(1,idihedral)
            ibsite = molecules(imoltype)%dihedrals_sites(2,idihedral)
            icsite = molecules(imoltype)%dihedrals_sites(3,idihedral)
            idsite = molecules(imoltype)%dihedrals_sites(4,idihedral)

            iatype=molecules(imoltype)%sites(iasite)
            ibtype=molecules(imoltype)%sites(ibsite)
            ictype=molecules(imoltype)%sites(icsite)
            idtype=molecules(imoltype)%sites(idsite)

            !$acc parallel loop &
            !$acc private(imol, ia, ib, &
            !$acc         dxab, dyab, dzab, drnormab2,  &
            !$acc         dxbc, dybc, dzbc, drnormbc2,  &
            !$acc         dxcd, dycd, dzcd, drnormcd2,  &
            !$acc         rabXrbc(:), normrabXrbc2, normrabXrbc, &
            !$acc         rbcXrcd(:), normrbcXrcd2, normrbcXrcd, &
            !$acc         rabXrbcdotrbcXrcd, cos_phi, phi, sin_phi, &
            !$acc         sin_2phi, sin_3phi, sin_4phi, dudphi, &
            !$acc         prefactor1, prefactor2, prefactor3, prefactor4, &
            !$acc         dxabbc, dxbccd, dxabcd, dxabab, dxbcbc, dxcdcd, &
            !$acc         dyabbc, dybccd, dyabcd, dyabab, dybcbc, dycdcd, &
            !$acc         dzabbc, dzbccd, dzabcd, dzabab, dzbcbc, dzcdcd)

            do imol = localwork%molecules_istart(imoltype), localwork%molecules_iend(imoltype)

               ia = ions(iatype)%offset + imol
               ib = ions(ibtype)%offset + imol
               ic = ions(ictype)%offset + imol
               id = ions(idtype)%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), &
                     dxab, dyab, dzab, drnormab2)

               call minimum_image_displacement_@PBC@(a, b, c, &
                     xyz_ions(ib,1), xyz_ions(ib,2), xyz_ions(ib,3), &
                     xyz_ions(ic,1), xyz_ions(ic,2), xyz_ions(ic,3), &
                     dxbc, dybc, dzbc, drnormbc2)

               call minimum_image_displacement_@PBC@(a, b, c, &
                     xyz_ions(ic,1), xyz_ions(ic,2), xyz_ions(ic,3), &
                     xyz_ions(id,1), xyz_ions(id,2), xyz_ions(id,3), &
                     dxcd, dycd, dzcd, drnormcd2)

               rabXrbc(1)=dyab*dzbc-dzab*dybc    
               rabXrbc(2)=-dxab*dzbc+dzab*dxbc
               rabXrbc(3)=dxab*dybc-dyab*dxbc
               normrabXrbc2=rabXrbc(1)*rabXrbc(1)+rabXrbc(2)*rabXrbc(2)+rabXrbc(3)*rabXrbc(3)
               normrabXrbc=sqrt(normrabXrbc2)

               rbcXrcd(1)=dybc*dzcd-dzbc*dycd
               rbcXrcd(2)=-dxbc*dzcd+dzbc*dxcd
               rbcXrcd(3)=dxbc*dycd-dybc*dxcd
               normrbcXrcd2=rbcXrcd(1)*rbcXrcd(1)+rbcXrcd(2)*rbcXrcd(2)+rbcXrcd(3)*rbcXrcd(3)
               normrbcXrcd=sqrt(normrbcXrcd2)

               rabXrbcdotrbcXrcd=rabXrbc(1)*rbcXrcd(1)+rabXrbc(2)*rbcXrcd(2)+rabXrbc(3)*rbcXrcd(3)

               cos_phi=rabXrbcdotrbcXrcd/(normrabXrbc*normrbcXrcd)
               if (cos_phi > 1) then
                  cos_phi = 1
                  phi = acos(1.0_wp)
               else if (cos_phi < -1) then
                  cos_phi = -1
                  phi = acos(-1.0_wp)
               else
                  phi = acos(cos_phi)
               end if
               sin_phi=sin(phi)
               sin_2phi=sin(2.0_wp*phi)
               sin_3phi=sin(3.0_wp*phi)
               sin_4phi=sin(4.0_wp*phi)

               dudphi=-0.5_wp*v1*sin_phi+v2*sin_2phi-1.5_wp*v3*sin_3phi+2.0_wp*v4*sin_4phi
               prefactor1=0.0_wp
               if(sin_phi.ne.0.0_wp)prefactor1=dudphi/sin_phi

               prefactor2=prefactor1/(normrabXrbc*normrbcXrcd)

               dxabbc=dxab*dxbc
               dxbccd=dxbc*dxcd
               dxabcd=dxab*dxcd
               dxabab=dxab*dxab
               dxbcbc=dxbc*dxbc
               dxcdcd=dxcd*dxcd               

               dyabbc=dyab*dybc
               dybccd=dybc*dycd
               dyabcd=dyab*dycd
               dyabab=dyab*dyab
               dybcbc=dybc*dybc
               dycdcd=dycd*dycd               

               dzabbc=dzab*dzbc
               dzbccd=dzbc*dzcd
               dzabcd=dzab*dzcd
               dzabab=dzab*dzab
               dzbcbc=dzbc*dzbc
               dzcdcd=dzcd*dzcd               

               !$acc atomic update               
               force(ia,1) = force(ia,1) + prefactor2*(-dybccd*dxbc-dzbccd*dxbc+dybcbc*dxcd+dzbcbc*dxcd)
               !$acc atomic update               
               force(ia,2) = force(ia,2) + prefactor2*(-dxbccd*dybc-dzbccd*dybc+dxbcbc*dycd+dzbcbc*dycd)
               !$acc atomic update               
               force(ia,3) = force(ia,3) + prefactor2*(-dxbccd*dzbc-dybccd*dzbc+dxbcbc*dzcd+dybcbc*dzcd)

               !$acc atomic update               
               force(ib,1) = force(ib,1) + prefactor2* &
                           (-dybccd*dxab-dzbccd*dxab+dybccd*dxbc+dzbccd*dxbc  &
                            -dxcd*(dyabbc+dzabbc+dybcbc+dzbcbc) &
                            +2.0_wp*dxbc*(dyabcd+dzabcd))
               !$acc atomic update               
               force(ib,2) = force(ib,2) + prefactor2* &
                           (-dxbccd*dyab-dzbccd*dyab+dxbccd*dybc+dzbccd*dybc  &
                            -dycd*(dxabbc+dzabbc+dxbcbc+dzbcbc) &
                            +2.0_wp*dybc*(dxabcd+dzabcd))
               !$acc atomic update               
               force(ib,3) = force(ib,3) + prefactor2* &
                           (-dxbccd*dzab-dybccd*dzab+dxbccd*dzbc+dybccd*dzbc  &
                            -dzcd*(dxabbc+dyabbc+dxbcbc+dybcbc) &
                            +2.0_wp*dzbc*(dxabcd+dyabcd))

               !$acc atomic update               
               force(ic,1) = force(ic,1) + prefactor2* &
                           (dxab*(dybcbc+dzbcbc+dybccd+dzbccd) &
                            -dxbc*dyabbc-dxbc*dzabbc+dxcd*dyabbc+dxcd*dzabbc &
                            -2.0_wp*dxbc*(dyabcd+dzabcd))
               !$acc atomic update               
               force(ic,2) = force(ic,2) + prefactor2* &
                           (dyab*(dxbcbc+dzbcbc+dxbccd+dzbccd) &
                            -dybc*dxabbc-dybc*dzabbc+dycd*dxabbc+dycd*dzabbc &
                            -2.0_wp*dybc*(dxabcd+dzabcd))
               !$acc atomic update               
               force(ic,3) = force(ic,3) + prefactor2* &
                           (dzab*(dxbcbc+dybcbc+dxbccd+dybccd) &
                            -dzbc*dxabbc-dzbc*dyabbc+dzcd*dxabbc+dzcd*dyabbc &
                            -2.0_wp*dzbc*(dxabcd+dyabcd))

               !$acc atomic update               
               force(id,1) = force(id,1) + prefactor2*(-dxab*dybcbc-dxab*dzbcbc+dxbc*dyabbc+dxbc*dzabbc)
               !$acc atomic update               
               force(id,2) = force(id,2) + prefactor2*(-dyab*dxbcbc-dyab*dzbcbc+dybc*dxabbc+dybc*dzabbc)
               !$acc atomic update               
               force(id,3) = force(id,3) + prefactor2*(-dzab*dxbcbc-dzab*dybcbc+dzbc*dxabbc+dzbc*dyabbc)

               prefactor3=prefactor1*(-0.5_wp*cos_phi/normrabXrbc2)

               !$acc atomic update               
               force(ia,1) = force(ia,1) + prefactor3*(-2.0_wp*dxab*(dybcbc+dzbcbc)+2.0_wp*dxbc*(dyabbc+dzabbc))
               !$acc atomic update               
               force(ia,2) = force(ia,2) + prefactor3*(-2.0_wp*dyab*(dxbcbc+dzbcbc)+2.0_wp*dybc*(dxabbc+dzabbc))
               !$acc atomic update               
               force(ia,3) = force(ia,3) + prefactor3*(-2.0_wp*dzab*(dxbcbc+dybcbc)+2.0_wp*dzbc*(dxabbc+dyabbc))

               !$acc atomic update               
               force(ib,1) = force(ib,1) + prefactor3*(2.0_wp*dxab*(dybcbc+dzbcbc+dyabbc+dzabbc) &
                                                      -2.0_wp*dxbc*(dyabab+dzabab+dyabbc+dzabbc))
               !$acc atomic update               
               force(ib,2) = force(ib,2) + prefactor3*(2.0_wp*dyab*(dxbcbc+dzbcbc+dxabbc+dzabbc) &
                                                      -2.0_wp*dybc*(dxabab+dzabab+dxabbc+dzabbc))
               !$acc atomic update               
               force(ib,3) = force(ib,3) + prefactor3*(2.0_wp*dzab*(dxbcbc+dybcbc+dxabbc+dyabbc) &
                                                      -2.0_wp*dzbc*(dxabab+dyabab+dxabbc+dyabbc))

               !$acc atomic update               
               force(ic,1) = force(ic,1) + prefactor3*(-2.0_wp*dxab*(dyabbc+dzabbc)+2.0_wp*dxbc*(dyabab+dzabab))
               !$acc atomic update               
               force(ic,2) = force(ic,2) + prefactor3*(-2.0_wp*dyab*(dxabbc+dzabbc)+2.0_wp*dybc*(dxabab+dzabab))
               !$acc atomic update               
               force(ic,3) = force(ic,3) + prefactor3*(-2.0_wp*dzab*(dxabbc+dyabbc)+2.0_wp*dzbc*(dxabab+dyabab))

               ! this term is null for site id 
               prefactor4=prefactor1*(-0.5_wp*cos_phi/normrbcXrcd2)

               ! this term is null for site ia
               !$acc atomic update               
               force(ib,1) = force(ib,1) + prefactor4*(2.0_wp*dxcd*(dybccd+dzbccd)-2.0_wp*dxbc*(dycdcd+dzcdcd))
               !$acc atomic update               
               force(ib,2) = force(ib,2) + prefactor4*(2.0_wp*dycd*(dxbccd+dzbccd)-2.0_wp*dybc*(dxcdcd+dzcdcd))
               !$acc atomic update               
               force(ib,3) = force(ib,3) + prefactor4*(2.0_wp*dzcd*(dxbccd+dybccd)-2.0_wp*dzbc*(dxcdcd+dycdcd))

               !$acc atomic update               
               force(ic,1) = force(ic,1) + prefactor4*(-2.0_wp*dxcd*(dybcbc+dzbcbc+dybccd+dzbccd) &
                                                       +2.0_wp*dxbc*(dycdcd+dzcdcd+dybccd+dzbccd))
               !$acc atomic update               
               force(ic,2) = force(ic,2) + prefactor4*(-2.0_wp*dycd*(dxbcbc+dzbcbc+dxbccd+dzbccd) &
                                                       +2.0_wp*dybc*(dxcdcd+dzcdcd+dxbccd+dzbccd))
               !$acc atomic update               
               force(ic,3) = force(ic,3) + prefactor4*(-2.0_wp*dzcd*(dxbcbc+dybcbc+dxbccd+dybccd) &
                                                       +2.0_wp*dzbc*(dxcdcd+dycdcd+dxbccd+dybccd))

               !$acc atomic update               
               force(id,1) = force(id,1) + prefactor4*(2.0_wp*dxcd*(dybcbc+dzbcbc)-2.0_wp*dxbc*(dybccd+dzbccd))
               !$acc atomic update               
               force(id,2) = force(id,2) + prefactor4*(2.0_wp*dycd*(dxbcbc+dzbcbc)-2.0_wp*dybc*(dxbccd+dzbccd))
               !$acc atomic update               
               force(id,3) = force(id,3) + prefactor4*(2.0_wp*dzcd*(dxbcbc+dybcbc)-2.0_wp*dzbc*(dxbccd+dybccd))

            end do
            !$acc end parallel loop            
         end do
      end if
   end do
   !$acc end data

   call MW_timers_stop(TIMER_INTRA_MELT_FORCES)   
end subroutine forces_@PBC@

! ================================================================================
!> Compute the energy due to dihedral 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_dihedrals, idihedral
   integer :: iatype, ibtype, ictype, idtype
   integer :: iasite, ibsite, icsite, idsite
   integer :: ia, ib, ic, id
   real(wp) :: a, b, c
   real(wp) :: dxab, dyab, dzab, drnormab2
   real(wp) :: dxbc, dybc, dzbc, drnormbc2
   real(wp) :: dxcd, dycd, dzcd, drnormcd2
   real(wp), dimension(3) :: rabXrbc,rbcXrcd
   real(wp) :: normrabXrbc2,normrbcXrcd2
   real(wp) :: normrabXrbc,normrbcXrcd
   real(wp) :: rabXrbcdotrbcXrcd
   real(wp) :: v1,v2,v3,v4
   real(wp) :: phi,Uab
   real(wp) :: cos_phi,cos_2phi,cos_3phi,cos_4phi

   call MW_timers_start(TIMER_INTRA_MELT_POTENTIAL)

   num_molecule_types = size(molecules,1)

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

   do imoltype = 1, num_molecule_types
      num_dihedrals = molecules(imoltype)%num_dihedrals
      if (num_dihedrals > 0) then
         do idihedral = 1, num_dihedrals
            v1 = molecules(imoltype)%dihedrals_v1(idihedral)
            v2 = molecules(imoltype)%dihedrals_v2(idihedral)
            v3 = molecules(imoltype)%dihedrals_v3(idihedral)
            v4 = molecules(imoltype)%dihedrals_v4(idihedral)

            iasite = molecules(imoltype)%dihedrals_sites(1,idihedral)
            ibsite = molecules(imoltype)%dihedrals_sites(2,idihedral)
            icsite = molecules(imoltype)%dihedrals_sites(3,idihedral)
            idsite = molecules(imoltype)%dihedrals_sites(4,idihedral)

            iatype=molecules(imoltype)%sites(iasite)
            ibtype=molecules(imoltype)%sites(ibsite)
            ictype=molecules(imoltype)%sites(icsite)
            idtype=molecules(imoltype)%sites(idsite)

            do imol = localwork%molecules_istart(imoltype), localwork%molecules_iend(imoltype)
               ia = ions(iatype)%offset + imol
               ib = ions(ibtype)%offset + imol
               ic = ions(ictype)%offset + imol
               id = ions(idtype)%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), &
                     dxab, dyab, dzab, drnormab2)

               call minimum_image_displacement_@PBC@(a, b, c, &
                     xyz_ions(ib,1), xyz_ions(ib,2), xyz_ions(ib,3), &
                     xyz_ions(ic,1), xyz_ions(ic,2), xyz_ions(ic,3), &
                     dxbc, dybc, dzbc, drnormbc2)

               call minimum_image_displacement_@PBC@(a, b, c, &
                     xyz_ions(ic,1), xyz_ions(ic,2), xyz_ions(ic,3), &
                     xyz_ions(id,1), xyz_ions(id,2), xyz_ions(id,3), &
                     dxcd, dycd, dzcd, drnormcd2)

               rabXrbc(1)=dyab*dzbc-dzab*dybc
               rabXrbc(2)=-dxab*dzbc+dzab*dxbc
               rabXrbc(3)=dxab*dybc-dyab*dxbc
               normrabXrbc2=rabXrbc(1)*rabXrbc(1)+rabXrbc(2)*rabXrbc(2)+rabXrbc(3)*rabXrbc(3)
               normrabXrbc=sqrt(normrabXrbc2)

               rbcXrcd(1)=dybc*dzcd-dzbc*dycd
               rbcXrcd(2)=-dxbc*dzcd+dzbc*dxcd
               rbcXrcd(3)=dxbc*dycd-dybc*dxcd
               normrbcXrcd2=rbcXrcd(1)*rbcXrcd(1)+rbcXrcd(2)*rbcXrcd(2)+rbcXrcd(3)*rbcXrcd(3)
               normrbcXrcd=sqrt(normrbcXrcd2)

               rabXrbcdotrbcXrcd=rabXrbc(1)*rbcXrcd(1)+rabXrbc(2)*rbcXrcd(2)+rabXrbc(3)*rbcXrcd(3)

               cos_phi=rabXrbcdotrbcXrcd/(normrabXrbc*normrbcXrcd)
               if (cos_phi > 1) then
                  cos_phi = 1
                  phi = acos(1.0_wp)
               else if (cos_phi < -1) then
                  cos_phi = -1
                  phi = acos(-1.0_wp)
               else
                  phi = acos(cos_phi)
               endif
               cos_2phi=cos(2.0_wp*phi)
               cos_3phi=cos(3.0_wp*phi)
               cos_4phi=cos(4.0_wp*phi)

               Uab = 0.5_wp*(v1*(1.0_wp+cos_phi)+v2*(1.0_wp-cos_2phi)+v3*(1.0_wp+cos_3phi)+v4*(1.0_wp-cos_4phi))
               h = h + Uab
            end do
         end do
      end if
   end do

   call MW_timers_stop(TIMER_INTRA_MELT_POTENTIAL)

end subroutine energy_@PBC@


