! ==============================================================================
! Compute Lennard-Jones forces felt by melt ions
!!
! This comment line is necessary so that openACC kernels do not line up with those from fumi_tosi_@PBC@.inc
!DEC$ ATTRIBUTES NOINLINE :: melt_forces_@PBC@_soft_core
subroutine melt_forces_soft_core_@PBC@(localwork, lj, 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_lennard_jones_t), intent(in) :: lj      !< Lennard-Jones 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(:,:) !< (soft core) LJ force on ions
   real(wp), intent(inout) :: stress_tensor(:,:) !< (soft core) LJ stress_tensor

   ! Locals
   ! ------
   integer :: num_ion_types, num_elec
   integer :: itype, jtype, i, j
   real(wp) :: a, b, c
   real(wp) :: drnorm2, dx, dy, dz, drnorm6
   real(wp) :: lj_ij, A_ij, B_ij, shift_ij, fix, fiy, fiz, rcutsq
   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) :: drnorm6rec, drnorm12rec
   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 = lj%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(:,:), electrodes)  &
   !$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)   

   !$acc kernels
   force(:,:) = 0.0_wp
   !$acc end kernels

   ! 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
         A_ij = lj%A(itype, jtype)
         B_ij = lj%B(itype, jtype)
         shift_ij = lj%shift(itype, jtype)
         if (A_ij > 0) then
            ! 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) 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 i = istart, iend
                  fix = 0.0_wp
                  fiy = 0.0_wp
                  fiz = 0.0_wp
                  !$acc loop reduction(+:fix,fiy,fiz) &
                  !$acc private(dx, dy, dz, drnorm2, lj_ij, drnorm6, drnorm6rec, drnorm12rec)
                  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
                        drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                        drnorm6rec = 1.0_wp / drnorm6
                        drnorm12rec = drnorm6rec * drnorm6rec
                        lj_ij = (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec*drnorm2*drnorm2

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

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

                        !$acc atomic update
                        force(j,1) = force(j,1) - dx * lj_ij
                        !$acc atomic update
                        force(j,2) = force(j,2) - dy * lj_ij
                        !$acc atomic update
                        force(j,3) = force(j,3) - dz * lj_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 if
      end do

      A_ij = lj%A(itype, itype)
      B_ij = lj%B(itype, itype)
      shift_ij = lj%shift(itype, itype)

      if (A_ij > 0) then
         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 &
            !$acc private(fix, fiy, fiz)  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 i = istart, iend
               fix = 0.0_wp
               fiy = 0.0_wp
               fiz = 0.0_wp
               !$acc loop reduction(+:fix,fiy,fiz) &
               !$acc private(dx, dy, dz, drnorm2, lj_ij, drnorm6, drnorm6rec, drnorm12rec)
               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
                     drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                     drnorm6rec = 1.0_wp / drnorm6
                     drnorm12rec = drnorm6rec * drnorm6rec
                     lj_ij = (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec*drnorm2*drnorm2

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

                     loc_stress_tensor_xx = loc_stress_tensor_xx - 0.5_wp * dx * dx * lj_ij
                     loc_stress_tensor_yy = loc_stress_tensor_yy - 0.5_wp * dy * dy * lj_ij
                     loc_stress_tensor_zz = loc_stress_tensor_zz - 0.5_wp * dz * dz * lj_ij
                     loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * dx * dy * lj_ij
                     loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * dx * dz * lj_ij
                     loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * dy * dz * lj_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 &
            !$acc private(fix, fiy, fiz)   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 i = istart, iend
               fix = 0.0_wp
               fiy = 0.0_wp
               fiz = 0.0_wp
               !$acc loop reduction(+:fix,fiy,fiz) &
               !$acc private(dx, dy, dz, drnorm2, lj_ij, drnorm6, drnorm6rec, drnorm12rec)
               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
                     drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                     drnorm6rec = 1.0_wp / drnorm6
                     drnorm12rec = drnorm6rec * drnorm6rec
                     lj_ij = (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec*drnorm2*drnorm2

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

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

                     !$acc atomic update
                     force(j,1) = force(j,1) - dx * lj_ij
                     !$acc atomic update
                     force(j,2) = force(j,2) - dy * lj_ij
                     !$acc atomic update
                     force(j,3) = force(j,3) - dz * lj_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 if

      do jtype = 1, num_elec
         count_m = electrodes(jtype)%count
         offset_m = electrodes(jtype)%offset
         A_ij = lj%A(itype, jtype+num_ion_types)
         B_ij = lj%B(itype, jtype+num_ion_types)
         shift_ij = lj%shift(itype, jtype+num_ion_types)
         if (A_ij > 0) then
            ! 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(dx, dy, dz, drnorm2, lj_ij, drnorm6, drnorm6rec, drnorm12rec)
                  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
                        drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                        drnorm6rec = 1.0_wp / drnorm6
                        drnorm12rec = drnorm6rec * drnorm6rec
                        lj_ij = (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec*drnorm2*drnorm2

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

                        loc_stress_tensor_xx = loc_stress_tensor_xx - dx * dx * lj_ij
                        loc_stress_tensor_yy = loc_stress_tensor_yy - dy * dy * lj_ij
                        loc_stress_tensor_zz = loc_stress_tensor_zz - dz * dz * lj_ij
                        loc_stress_tensor_xy = loc_stress_tensor_xy - dx * dy * lj_ij
                        loc_stress_tensor_xz = loc_stress_tensor_xz - dx * dz * lj_ij
                        loc_stress_tensor_yz = loc_stress_tensor_yz - dy * dz * lj_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,6) = electrodes(jtype)%force_ions(1,6) + loc_electrode_force_x 
               electrodes(jtype)%force_ions(2,6) = electrodes(jtype)%force_ions(2,6) + loc_electrode_force_y
               electrodes(jtype)%force_ions(3,6) = electrodes(jtype)%force_ions(3,6) + loc_electrode_force_z
            end do
         end if
      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_soft_core_@PBC@

! ==============================================================================
! Compute Lennard-Jones potential felt by melt ions
!DEC$ ATTRIBUTES NOINLINE :: energy_@PBC@_soft_core
subroutine energy_soft_core_@PBC@(localwork, lj, box, ions, xyz_ions, &
      electrodes, xyz_atoms, h)
   implicit none

   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in) :: localwork !< Local work assignment
   type(MW_lennard_jones_t), intent(in) :: lj      !< Lennard-Jones 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, vi_rcut, lj_ij, A_ij, B_ij, v_rcut, shift_ij, alpha_ij, sigma6_ij
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: num_block_diag, num_block_full
   integer :: count_n, offset_n, count_m, offset_m
   real(wp) :: drnorm6, drnorm6rec, drnorm12rec
   real(wp) :: fi, fi_ij

   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 = lj%rcutsq
   h(:) = 0.0_wp
   vi = 0.0_wp
   vi_rcut = 0.0_wp
   fi = 0.0_wp
   !$acc data present(xyz_ions(:,:), xyz_atoms(:,:), lj) copy(vi, vi_rcut, fi)

   ! 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
         A_ij = lj%A(itype, jtype)
         B_ij = lj%B(itype, jtype)
         shift_ij = lj%shift(itype, jtype)
         alpha_ij = lj%alpha(itype, jtype)
         sigma6_ij = A_ij / B_ij
         v_rcut = potential_ij(rcutsq, A_ij, B_ij)
         if (A_ij > 0) then
            ! 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, vi_rcut, fi) &
               !$acc private(drnorm2, drnorm6, drnorm6rec, drnorm12rec, lj_ij, fi_ij)
               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
                        drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                        drnorm6rec = 1.0_wp / drnorm6
                        drnorm12rec = drnorm6rec * drnorm6rec

                        lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec

                        vi = vi + lj_ij
                        vi_rcut = vi_rcut + v_rcut

                        if (alpha_ij > 0) then
                           fi_ij = sigma6_ij * (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec
                           fi = fi + fi_ij
                        end if
                     end if
                  end do
               end do
               !$acc end parallel loop
            end do
         end if
      end do

      A_ij = lj%A(itype, itype)
      B_ij = lj%B(itype, itype)
      shift_ij = lj%shift(itype, itype)
      alpha_ij = lj%alpha(itype, itype)
      sigma6_ij = A_ij / B_ij
      v_rcut = potential_ij(rcutsq, A_ij, B_ij)
      if (A_ij > 0) then
         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, vi_rcut, fi) &
            !$acc private(drnorm2, drnorm6, drnorm6rec, drnorm12rec, lj_ij, fi_ij)
            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
                     drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                     drnorm6rec = 1.0_wp / drnorm6
                     drnorm12rec = drnorm6rec * drnorm6rec

                     lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec

                     vi = vi + 0.5_wp * lj_ij
                     vi_rcut = vi_rcut + 0.5_wp * v_rcut

                     if (alpha_ij > 0) then
                        fi_ij = sigma6_ij * (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec
                        fi = fi + fi_ij
                     end if
                  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, vi_rcut, fi) &
            !$acc private(drnorm2, drnorm6, drnorm6rec, drnorm12rec, lj_ij, fi_ij)
            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
                     drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                     drnorm6rec = 1.0_wp / drnorm6
                     drnorm12rec = drnorm6rec * drnorm6rec

                     lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec

                     vi = vi + lj_ij
                     vi_rcut = vi_rcut + v_rcut

                     if (alpha_ij > 0) then
                        fi_ij = sigma6_ij * (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec
                        fi = fi + fi_ij
                     end if
                  end if
               end do
            end do
            !$acc end parallel loop
         end do
      end if

      do jtype = 1, num_elec
         count_m = electrodes(jtype)%count
         offset_m = electrodes(jtype)%offset
         A_ij = lj%A(itype, jtype+num_ion_types)
         B_ij = lj%B(itype, jtype+num_ion_types)
         shift_ij = lj%shift(itype, jtype+num_ion_types)
         alpha_ij = lj%alpha(itype, jtype+num_ion_types)
         sigma6_ij = A_ij / B_ij
         v_rcut = potential_ij(rcutsq, A_ij, B_ij)
         if (A_ij > 0) then
            ! 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, vi_rcut, fi) &
               !$acc private(drnorm2, drnorm6, drnorm6rec, drnorm12rec, lj_ij, fi_ij)
               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
                        drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                        drnorm6rec = 1.0_wp / drnorm6
                        drnorm12rec = drnorm6rec * drnorm6rec

                        lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec

                        vi = vi + lj_ij
                        vi_rcut = vi_rcut + v_rcut

                        if (alpha_ij > 0) then
                           fi_ij = sigma6_ij * (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec
                           fi = fi + fi_ij
                        end if
                     end if
                  end do
               end do
               !$acc end parallel loop
            end do
         end if
      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
         A_ij = lj%A(itype+num_ion_types, jtype+num_ion_types)
         B_ij = lj%B(itype+num_ion_types, jtype+num_ion_types)
         shift_ij = lj%shift(itype+num_ion_types, jtype+num_ion_types)
         alpha_ij = lj%alpha(itype+num_ion_types, jtype+num_ion_types)
         sigma6_ij = A_ij / B_ij
         v_rcut = potential_ij(rcutsq, A_ij, B_ij)
         if (A_ij > 0) then
            ! 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, vi_rcut, fi) &
               !$acc private(drnorm2, drnorm6, drnorm6rec, drnorm12rec, lj_ij, fi_ij)
               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
                        drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                        drnorm6rec = 1.0_wp / drnorm6
                        drnorm12rec = drnorm6rec * drnorm6rec

                        lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec

                        vi = vi + lj_ij
                        vi_rcut = vi_rcut + v_rcut

                        if (alpha_ij > 0) then
                           fi_ij = sigma6_ij * (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec
                           fi = fi + fi_ij
                        end if
                     end if
                  end do
               end do
               !$acc end parallel loop
            end do
         end if
      end do

      A_ij = lj%A(itype+num_ion_types, itype+num_ion_types)
      B_ij = lj%B(itype+num_ion_types, itype+num_ion_types)
      shift_ij = lj%shift(itype+num_ion_types, itype+num_ion_types)
      alpha_ij = lj%alpha(itype+num_ion_types, itype+num_ion_types)
      sigma6_ij = A_ij / B_ij
      v_rcut = potential_ij(rcutsq, A_ij, B_ij)
      if (A_ij > 0) then
         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, vi_rcut, fi) &
            !$acc private(drnorm2, drnorm6, drnorm6rec, drnorm12rec, lj_ij, fi_ij)
            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
                     drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                     drnorm6rec = 1.0_wp / drnorm6
                     drnorm12rec = drnorm6rec * drnorm6rec

                     lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec

                     vi = vi + 0.5_wp * lj_ij
                     vi_rcut = vi_rcut + 0.5_wp * v_rcut

                     if (alpha_ij > 0) then
                        fi_ij = sigma6_ij * (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec
                        fi = fi + fi_ij
                     end if
                  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, vi_rcut, fi) &
            !$acc private(drnorm2, drnorm6, drnorm6rec, drnorm12rec, lj_ij, fi_ij)
            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
                     drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                     drnorm6rec = 1.0_wp / drnorm6
                     drnorm12rec = drnorm6rec * drnorm6rec

                     lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec

                     vi = vi + lj_ij
                     vi_rcut = vi_rcut + v_rcut

                     if (alpha_ij > 0) then
                        fi_ij = sigma6_ij * (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec
                        fi = fi + fi_ij
                     end if
                  end if
               end do
            end do
            !$acc end parallel loop
         end do
      end if
   end do
   !$acc end data
   h(1) = vi - vi_rcut
   h(2) = fi

   call MW_timers_stop(TIMER_VAN_DER_WAALS_MELT_POTENTIAL)
end subroutine energy_soft_core_@PBC@

! ================================================================================
! Remove contribution from same molecule particles
!
subroutine melt_fix_molecule_forces_soft_core_@PBC@(localwork, lj, molecules, box, ions, &
      xyz_ions, force,stress_tensor)
   implicit none
   ! Parameters
   ! ----------
   type(MW_localwork_t), intent(in) :: localwork
   type(MW_lennard_jones_t), intent(in) :: lj      !< Lennard-Jones 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, iion_type_offset, jion_type_offset
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz, drnorm2, drnorm6
   real(wp) :: lj_ij, A_ij, B_ij, shift_ij, rcutsq
   real(wp) :: drnorm12rec, drnorm6rec
   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)

   rcutsq = lj%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 &
   !$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

               A_ij = lj%A(iion_type,jion_type)
               B_ij = lj%B(iion_type,jion_type)
               shift_ij = lj%shift(iion_type,jion_type)

               if (A_ij > 0.0_wp) then
                  !$acc parallel loop &
                  !$acc private(imol, iion, jion, dx, dy, dz, drnorm2, lj_ij, drnorm6, drnorm6rec, drnorm12rec) &
                  !$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 < rcutsq) then
                        drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                        drnorm6rec = 1.0_wp / drnorm6
                        drnorm12rec = drnorm6rec * drnorm6rec
                        lj_ij = (-12.0_wp*A_ij*drnorm6rec + 6.0_wp*B_ij)*drnorm12rec*drnorm2*drnorm2

                        loc_stress_tensor_xx = loc_stress_tensor_xx + dx * dx * lj_ij * scaling14
                        loc_stress_tensor_yy = loc_stress_tensor_yy + dy * dy * lj_ij * scaling14
                        loc_stress_tensor_zz = loc_stress_tensor_zz + dz * dz * lj_ij * scaling14
                        loc_stress_tensor_xy = loc_stress_tensor_xy + dx * dy * lj_ij * scaling14
                        loc_stress_tensor_xz = loc_stress_tensor_xz + dx * dz * lj_ij * scaling14
                        loc_stress_tensor_yz = loc_stress_tensor_yz + dy * dz * lj_ij * scaling14
                        !$acc atomic update
                        force(iion,1) = force(iion,1) - dx * lj_ij * scaling14
                        !$acc atomic update
                        force(iion,2) = force(iion,2) - dy * lj_ij * scaling14
                        !$acc atomic update
                        force(iion,3) = force(iion,3) - dz * lj_ij * scaling14

                        !$acc atomic update
                        force(jion,1) = force(jion,1) + dx * lj_ij * scaling14
                        !$acc atomic update
                        force(jion,2) = force(jion,2) + dy * lj_ij * scaling14
                        !$acc atomic update
                        force(jion,3) = force(jion,3) + dz * lj_ij * scaling14
                     end if
                  end do
                  !$acc end parallel loop
               end if
            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_soft_core_@PBC@

! ================================================================================
! Remove contribution from same molecule particles
!
! This comment line is necessary so that openACC kernels do not line up with those from fumi_tosi_@PBC@.inc
subroutine fix_molecule_energy_soft_core_@PBC@(localwork, lj, molecules, box, ions, &
      xyz_ions, h)
   implicit none
   ! Parameters
   ! ----------
   type(MW_localwork_t), intent(in) :: localwork
   type(MW_lennard_jones_t), intent(in) :: lj      !< Lennard-Jones 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
   real(wp) :: a, b, c
   real(wp) :: drnorm2, vi, vi_rcut, rcutsq
   real(wp) :: lj_ij, lj_rcut6, lj_rcut12, A_ij, B_ij, v_rcut, shift_ij
   real(wp) :: drnorm6, drnorm6rec, drnorm12rec
   real(wp) :: scaling14

   lj_rcut6 = 1.0_wp/(lj%rcut)**6
   lj_rcut12 = 1.0_wp/(lj%rcut)**12
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)
   rcutsq  = lj%rcutsq

   h(:) = 0.0_wp
   vi = 0.0_wp
   vi_rcut = 0.0_wp
   !$acc data copy(vi, vi_rcut), &
   !$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)
               A_ij = lj%A(iion_type,jion_type)
               B_ij = lj%B(iion_type,jion_type)
               shift_ij = lj%shift(iion_type,jion_type)
               v_rcut = potential_ij(rcutsq, A_ij, B_ij)
               if (A_ij > 0.0_wp) then
                  !$acc parallel loop &
                  !$accprivate(imol, iion, jion, drnorm2, lj_ij, drnorm6, drnorm6rec, drnorm12rec) &
                  !$acc reduction(+:vi, vi_rcut)
                  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 < rcutsq) then
                        drnorm6 = shift_ij + drnorm2 * drnorm2 * drnorm2 !< shift potential
                        drnorm6rec = 1.0_wp / drnorm6
                        drnorm12rec = drnorm6rec * drnorm6rec

                        lj_ij = A_ij * drnorm12rec - B_ij * drnorm6rec
                        vi = vi + lj_ij * scaling14
                        vi_rcut = vi_rcut + v_rcut * scaling14
                     end if
                  end do
               end if
            end if
         end do
      end do
   end do
   !$acc end data
   h(1) = - vi + vi_rcut
   h(2) = 0
end subroutine fix_molecule_energy_soft_core_@PBC@
