! ==============================================================================
! Compute Steele 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@
subroutine melt_forces_@PBC@(localwork, steele, 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_steele_t), intent(in) :: steele      !< Steele potential parameters
   type(MW_box_t),   intent(in) :: box     !< Simulation box parameters

   type(MW_ion_t), intent(in) :: ions(:)        !< ions parameters
   type(MW_electrode_t), intent(inout) :: electrodes(:)        !< electrodes parameters
   real(wp),       intent(in) :: xyz_ions(:,:)  !< ions xyz positions
   real(wp),       intent(in) :: xyz_atoms(:,:)  !< atoms xyz positions

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

   ! Locals
   ! ------
   integer :: num_ion_types, num_walls
   integer :: itype, jtype, j, jlocal, i, offset_e
   real(wp) :: a, b, c
   real(wp) :: dz, dz2, zwall
   real(wp) :: f_ij, A_ij, B_ij, rcutsq, delta_i 
   integer :: local_count_m, local_offset_m
   real(wp) :: dzrec, dz2rec, dz6rec, dz5rec, dzdeltrec, dzdelt2rec, dzdelt4rec, dzspec, sign_z
   real(wp) :: fz_melt2ele

   call MW_timers_start(TIMER_VAN_DER_WAALS_MELT_FORCES)
   num_ion_types = size(ions,1)
   num_walls = steele%num_walls

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

   force(:) = 0.0_wp

   rcutsq = steele%rcutsq


   ! Blocks on the diagonal compute only half of the pair interactions
   do itype = 1, num_walls
      delta_i = steele%delta(itype) 
      offset_e = electrodes(itype)%offset
      i = offset_e+1
      zwall = xyz_atoms(i, 3)
      fz_melt2ele = 0.0_wp

      do jtype = 1, num_ion_types
         A_ij = steele%A(itype, jtype)
         B_ij = steele%B(itype, jtype)
         if (A_ij > 0) then
            local_count_m = localwork%count_ions(jtype)
            local_offset_m = localwork%offset_ions(jtype)
            do jlocal = 1, local_count_m
               j = jlocal + local_offset_m
               dz = xyz_ions(j,3) - zwall
               dz2 = dz * dz
               if (dz2 < rcutsq) then
                  sign_z = dz / abs(dz)
                  dz = abs(dz)
                  dz2rec = 1.0_wp / dz2
                  dzrec = 1.0_wp / dz
                  dz5rec = dz2rec * dz2rec * dzrec
                  dz6rec = dz2rec * dz2rec * dz2rec
                  dzdeltrec = 1.0_wp / (dz + 0.61_wp * delta_i)
                  dzdelt2rec = dzdeltrec * dzdeltrec
                  dzdelt4rec = dzdelt2rec * dzdelt2rec
                  dzspec = 1.0_wp / delta_i * dzdelt4rec
                  f_ij = (-10.0_wp*A_ij*dz6rec - 4.0_wp*B_ij)*dz5rec - B_ij * dzspec
          
                  force(j) = force(j) - f_ij*sign_z
                  fz_melt2ele = fz_melt2ele + f_ij*sign_z

                  stress_tensor(3,3) = stress_tensor(3,3) - dz*f_ij*sign_z
                  
               end if
            end do
         end if
      end do
      electrodes(itype)%force_ions(3,9) = electrodes(itype)%force_ions(3,9) + fz_melt2ele
   end do

   call MW_timers_stop(TIMER_VAN_DER_WAALS_MELT_FORCES)

end subroutine melt_forces_@PBC@

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

   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in) :: localwork !< Local work assignment
   type(MW_steele_t), intent(in) :: steele      !< Lennard-Jones potential parameters
   type(MW_box_t),   intent(in) :: box     !< Simulation box parameters

   type(MW_ion_t), intent(in) :: ions(:)        !< ions parameters
   type(MW_electrode_t), intent(in) :: electrodes(:)        !< electrodes parameters
   real(wp),       intent(in) :: xyz_ions(:,:)  !< ions xyz positions
   real(wp),       intent(in) :: xyz_atoms(:,:)  !< atoms xyz positions

   ! Parameters out
   ! --------------
   real(wp), intent(inout) :: h       !< Potential energy due to steele interactions

   ! Locals
   ! ------
   integer :: num_ion_types, num_walls
   integer :: itype, jtype, j, jlocal, i, offset_e
   real(wp) :: a, b, c
   real(wp) :: dz, xwall, ywall, zwall
   real(wp) :: h_ij, A_ij, B_ij, rcutsq, delta_i
   integer :: local_count_m, local_offset_m
   real(wp) :: dz2rec, dz4rec, dz10rec, dzdeltrec, dzdelt3rec, dzspec, dz2

   call MW_timers_start(TIMER_VAN_DER_WAALS_MELT_POTENTIAL)

   num_ion_types = size(ions,1)
   num_walls = steele%num_walls

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

   rcutsq = steele%rcutsq
   h = 0.0_wp

   ! Blocks on the diagonal compute only half of the pair interactions
   do itype = 1, num_walls
      delta_i = steele%delta(itype)
      xwall = 0.0_wp
      ywall = 0.0_wp
      offset_e = electrodes(itype)%offset
      i = offset_e+1
      zwall = xyz_atoms(i, 3)

      do jtype = 1, num_ion_types
         A_ij = steele%A(itype, jtype)
         B_ij = steele%B(itype, jtype)
         if (A_ij > 0) then
            local_count_m = localwork%count_ions(jtype)
            local_offset_m = localwork%offset_ions(jtype)
            do jlocal = 1, local_count_m
               j = jlocal + local_offset_m
               dz = xyz_ions(j,3) - zwall
               dz2 = dz * dz
               if (dz2 < rcutsq) then
                  dz = abs(dz)
                  dz2rec = 1.0_wp / dz2
                  dz4rec = dz2rec * dz2rec
                  dz10rec = dz4rec * dz4rec * dz2rec
                  dzdeltrec = 1.0_wp / (dz + 0.61_wp * delta_i)
                  dzdelt3rec = dzdeltrec * dzdeltrec * dzdeltrec
                  dzspec = 1.0_wp / (3.0_wp * delta_i) * dzdelt3rec
                  h_ij = A_ij * dz10rec + B_ij * dz4rec + B_ij * dzspec

                  h = h + h_ij
               end if
            end do
         end if
      end do
   end do

   call MW_timers_stop(TIMER_VAN_DER_WAALS_MELT_POTENTIAL)
end subroutine energy_@PBC@

