subroutine gradQelec_electricfield_@PBC@(localwork, ewald, box, ions, xyz_ions, &
      electrodes, xyz_atoms, gradQ_efield)
   implicit none

   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald          !< Ewald summation 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) :: gradQ_efield(:,:) !< Electric field on ions

   ! Local
   ! -----
   integer :: num_ions, num_ion_types, num_elec_types
   integer :: i, j, jx, jy, jz, itype, jtype
   real(wp) :: a, b, c
   real(wp) :: qj !< ion charge
   real(wp) :: dx, dy, dz
   real(wp) :: drnorm, drnorm2
   real(wp) :: drnormrec, drnorm2rec
   real(wp) :: alpha, alphasq, alphapi
   real(wp) :: eta, etasq, etapi
   real(wp) :: erfc_alpha, erfc_eta, exp_alpha, exp_eta
   real(wp) :: eij

   integer :: num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n, count_m, offset_m

   num_ion_types = size(ions,1)
   num_ions = size(gradQ_efield,1)/3
   num_elec_types = size(electrodes,1)
   num_ions = size(gradQ_efield,1)/3

   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi

   !$acc data present(xyz_ions(:,:), xyz_atoms(:,:), gradQ_efield(:,:))

   ! Short range contribution
   ! ------------------------
   do itype = 1, num_elec_types
      count_n = electrodes(itype)%count
      offset_n = electrodes(itype)%offset
      eta = electrodes(itype)%eta
      etasq = eta*eta
      etapi = 2.0_wp*eta/sqrtpi
      do jtype = 1, num_ion_types
         qj = ions(jtype)%charge
         if (ewald%sr_interaction_ion2atom(itype,jtype)) then
            count_m = ions(jtype)%count
            offset_m = ions(jtype)%offset
            ! Number of blocks with full ion2ion interactions
            num_block_full = localwork%pair_ion2atom_num_block_full_local(itype,jtype)
            iblock_offset = localwork%pair_ion2atom_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 &
               !$acc private(jx, jy, jz, &
               !$acc         dx, dy, dz, drnorm2, drnorm, drnormrec, drnorm2rec, &
               !$acc         erfc_alpha, exp_alpha, erfc_eta, exp_eta, eij)
               do i = istart, iend
                  !$acc loop
                  do j = jstart, jend
                     jx = j
                     jy = j + num_ions
                     jz = j + num_ions*2
                     call minimum_image_displacement_@PBC@(a, b, c, &
                          xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                          xyz_atoms(i,1), xyz_atoms(i,2), xyz_atoms(i,3), &
                          dx, dy, dz, drnorm2)
                     if (drnorm2 < ewald%rcutsq) then
                        drnorm = sqrt(drnorm2)
                        drnormrec = 1.0_wp/drnorm
                        drnorm2rec = drnormrec*drnormrec
                        ! Change erfc to 1-erf because of underflows
                        erfc_alpha = erfc(alpha*drnorm)*drnormrec
                        exp_alpha = exp(-alphasq*drnorm2)*alphapi
                        erfc_eta = erfc(eta*drnorm)*drnormrec
                        exp_eta = exp(-etasq*drnorm2)*etapi
                        eij =  drnorm2rec*((erfc_alpha + exp_alpha) - (erfc_eta + exp_eta))

                        !$acc atomic update
                        gradQ_efield(jx,i) = gradQ_efield(jx,i) + eij*dx
                        !$acc atomic update
                        gradQ_efield(jy,i) = gradQ_efield(jy,i) + eij*dy
                        !$acc atomic update
                        gradQ_efield(jz,i) = gradQ_efield(jz,i) + eij*dz
                     end if
                  end do
                  !acc end loop
               end do
               !$acc end parallel loop
            end do
         end if
      end do
   end do
   !$acc end data

end subroutine gradQelec_electricfield_@PBC@

!================================================================================
! Compute the gradient of the electric field for each ion in the melt with respect
! to variations of other dipoles in the melt
subroutine gradmumelt_electricfield_@PBC@(localwork, ewald, box, ions, xyz_ions, &
     gradmu_efield)
  implicit none

  ! Parameters in
  ! -------------
  type(MW_localwork_t),  intent(in)    :: localwork      !< Local work assignment
  type(MW_ewald_t),      intent(in)    :: ewald          !< Ewald summation 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

  ! Parameters out
  ! --------------
  real(wp),              intent(inout) :: gradmu_efield(:,:) !< matrix containing the
  ! gradient of the field

  ! Local
  ! -----
  integer :: num_ion_types, num_ions
  integer :: i, j, itype, jtype, ix, iy, iz, jx, jy, jz
  real(wp) :: a, b, c
  real(wp) :: drnorm2, dx, dy, dz
  real(wp) :: alpha, alphasq, alphapi
  real(wp), dimension(6) :: gmueij

  integer :: num_block_diag, num_block_full
  integer :: iblock, iblock_offset, istart, iend, jstart, jend
  integer :: count_n, offset_n, count_m, offset_m

  num_ion_types = size(ions,1)
  num_ions = size(gradmu_efield,1)/3

  ! Precompute some factors
  ! -----------------------
  a = box%length(1)
  b = box%length(2)
  c = box%length(3)

  alpha = ewald%alpha
  alphasq = alpha*alpha
  alphapi = 2.0_wp*alpha/sqrtpi

  !$acc data present(xyz_ions(:,:), gradmu_efield(:,:))

  ! Short range contribution
  ! ------------------------
  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
        if (ewald%sr_interaction_ion2ion(itype,jtype)) 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 &
              !$acc private(ix, iy, iz, jx, jy, jz, &
              !$acc         dx, dy, dz, drnorm2, &
              !$acc         gmueij(6))
              do i = istart, iend
                 ix = i
                 iy = i + num_ions
                 iz = i + num_ions*2
                 !$acc loop
                 do j = jstart, jend
                    jx = j
                    jy = j + num_ions
                    jz = j + num_ions*2
                    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 < ewald%rcutsq) then
                       gmueij = gradmumelt_elec_ij(drnorm2, dx, dy, dz, &
                            alpha, alphasq, alphapi)
                       !$acc atomic update
                       gradmu_efield(jx,ix) = gradmu_efield(jx,ix) + gmueij(1)
                       !$acc atomic update
                       gradmu_efield(jy,ix) = gradmu_efield(jy,ix) + gmueij(2)
                       !$acc atomic update
                       gradmu_efield(jz,ix) = gradmu_efield(jz,ix) + gmueij(3)

                       !$acc atomic update
                       gradmu_efield(jy,iy) = gradmu_efield(jy,iy) + gmueij(4)
                       !$acc atomic update
                       gradmu_efield(jz,iy) = gradmu_efield(jz,iy) + gmueij(5)

                       !$acc atomic update
                       gradmu_efield(jz,iz) = gradmu_efield(jz,iz) + gmueij(6)
                    end if
                 end do
                 !$acc end loop
              end do
              !$acc end parallel loop
           end do
        end if
     end do

     if (ewald%sr_interaction_ion2ion(itype,itype)) then
        ! Blocks on the diagonal compute only half of the pair interactions
        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(ix, iy, iz, jx, jy, jz, &
           !$acc         dx, dy, dz, drnorm2, &
           !$acc         gmueij(6))
           do i = istart, iend
              ix = i
              iy = i + num_ions
              iz = i + num_ions*2
              !$acc loop
              do j = istart, iend
                 jx = j
                 jy = j + num_ions
                 jz = j + num_ions*2
                 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 < ewald%rcutsq)) then
                    gmueij = gradmumelt_elec_ij(drnorm2, dx, dy, dz, &
                         alpha, alphasq, alphapi)
                    !$acc atomic update
                    gradmu_efield(jx,ix) = gradmu_efield(jx,ix) + gmueij(1)
                    !$acc atomic update
                    gradmu_efield(jy,ix) = gradmu_efield(jy,ix) + gmueij(2)
                    !$acc atomic update
                    gradmu_efield(jz,ix) = gradmu_efield(jz,ix) + gmueij(3)

                    !$acc atomic update
                    gradmu_efield(jy,iy) = gradmu_efield(jy,iy) + gmueij(4)
                    !$acc atomic update
                    gradmu_efield(jz,iy) = gradmu_efield(jz,iy) + gmueij(5)

                    !$acc atomic update
                    gradmu_efield(jz,iz) = gradmu_efield(jz,iz) + gmueij(6)
                 end if
              end do
              !$acc end loop
           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(ix, iy, iz, jx, jy, jz, &
           !$acc         dx, dy, dz, drnorm2, &
           !$acc         gmueij(6))
           do i = istart, iend
              ix = i
              iy = i + num_ions
              iz = i + num_ions*2
              !$acc loop
              do j = jstart, jend
                 jx = j
                 jy = j + num_ions
                 jz = j + num_ions*2
                 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 < ewald%rcutsq) then
                    gmueij = gradmumelt_elec_ij(drnorm2, dx, dy, dz, &
                         alpha, alphasq, alphapi)
                    !$acc atomic update
                    gradmu_efield(jx,ix) = gradmu_efield(jx,ix) + gmueij(1)
                    !$acc atomic update
                    gradmu_efield(jy,ix) = gradmu_efield(jy,ix) + gmueij(2)
                    !$acc atomic update
                    gradmu_efield(jz,ix) = gradmu_efield(jz,ix) + gmueij(3)

                    !$acc atomic update
                    gradmu_efield(jy,iy) = gradmu_efield(jy,iy) + gmueij(4)
                    !$acc atomic update
                    gradmu_efield(jz,iy) = gradmu_efield(jz,iy) + gmueij(5)

                    !$acc atomic update
                    gradmu_efield(jz,iz) = gradmu_efield(jz,iz) + gmueij(6)
                 end if
              end do
              !$acc end loop
           end do
           !$acc end parallel loop
        end do
     end if
  end do
  !$acc end data

end subroutine gradmumelt_electricfield_@PBC@

!================================================================================
! Compute the Coulomb potential felt by each electrode atoms due to all melt ions
!DEC$ ATTRIBUTES NOINLINE :: melt2elec_potential_@PBC@
subroutine mumelt2Qelec_potential_@PBC@(localwork, ewald, box, &
      ions, xyz_ions, electrodes, xyz_atoms, dipoles, type_electrode_atoms, V)
   implicit none

   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald     !< Ewald summation 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
   real(wp),             intent(in)    :: dipoles(:,:)
   integer,              intent(in)    :: type_electrode_atoms(:)

   ! Parameters out
   ! --------------
   real(wp),             intent(inout) :: V(:)       !< Coulomb potential

   ! Local
   ! -----
   integer  :: num_ion_types, num_elec_types
   integer  :: i, j
   real(wp) :: a, b, c
   real(wp) :: dx, dy, dz
   real(wp) :: drnorm2
   real(wp) :: alpha, alphasq, alphapi
   real(wp) :: etai, etaisq, etaipi
   real(wp) :: vi

   integer  :: num_block_full
   integer  :: iblock, iblock_offset, istart, iend, jstart, jend
   integer  :: count_n, offset_n, count_m, offset_m
   integer  :: num_ions, num_elec_atoms

   num_ion_types = size(ions,1)
   num_elec_types = size(electrodes,1)
   num_ions = 0
   if (num_ion_types > 0) then
      num_ions = ions(num_ion_types)%offset+ions(num_ion_types)%count
   end if
   num_elec_atoms = 0
   if (num_elec_types > 0) then
      num_elec_atoms = electrodes(num_elec_types)%offset+electrodes(num_elec_types)%count
   end if

   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi

   !$acc data present(xyz_atoms(:,:), xyz_ions(:,:), dipoles(:,:), type_electrode_atoms(:), V(:))

   ! Short range contribution
   ! ------------------------
   count_n = num_elec_atoms
   offset_n = 0

   count_m = num_ions
   offset_m = 0

   ! Number of blocks with full interactions (below the diagonal
   num_block_full = localwork%pair_ion2atom_num_block_full_local_ms
   iblock_offset = localwork%pair_ion2atom_full_iblock_offset_ms
   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(dx, dy, dz, drnorm2, &
      !$acc          vi, etai, etaisq, etaipi)
      do i = istart, iend
         etai = electrodes(type_electrode_atoms(i))%eta
         etaisq = etai*etai
         etaipi = 2.0_wp*etai/sqrtpi
         vi = 0.0_wp
         !$acc loop reduction(+:vi)
         do j = jstart, jend
            call minimum_image_displacement_@PBC@(a, b, c, &
                  xyz_ions(j,1), xyz_ions(j,2), xyz_ions(j,3), &
                  xyz_atoms(i,1), xyz_atoms(i,2), xyz_atoms(i,3), &
                  dx, dy, dz, drnorm2)
            if (drnorm2 < ewald%rcutsq) then
               vi = vi + pot_mumelt2Qelec_ij(drnorm2, dx, dy, dz, alpha, alphasq, alphapi, &
                     etai, etaisq, etaipi, dipoles(j,1), dipoles(j,2), dipoles(j,3))
            end if
         end do
         !$acc end loop
         V(i) = V(i) + vi
      end do
      !$acc end parallel loop
   end do
   !$acc end data
end subroutine mumelt2Qelec_potential_@PBC@

!================================================================================
! Compute the electric fields felt by each melt ions due to other melt ions
subroutine qmelt2mumelt_electricfield_@PBC@(localwork, ewald, box, ions, xyz_ions, &
      type_ions, efield, tt)
   implicit none
 
   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald          !< Ewald summation 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
   integer,              intent(in)    :: type_ions(:)
   type(MW_damping_t),   intent(in)    :: tt             !< Damping parameters
 
   ! Parameters out
   ! --------------
   real(wp),             intent(inout) :: efield(:,:) !< Electric field on ions
 
   ! Local
   ! -----
   integer :: num_ion_types
   integer :: i, j, itype, jtype
   integer :: kk
   real(wp) :: a, b, c
   real(wp) :: qi, qj !< ion charge
   real(wp) :: eij
   real(wp) :: drnorm, drnorm2, dx, dy, dz, drnorm3rec
   real(wp) :: alpha, alphasq, alphapi
   real(wp) :: xf, factorial
   real(wp) :: dampsumfi, dampexpi, dampfunci
   real(wp) :: dampsumfj, dampexpj, dampfuncj
   real(wp) :: dampbij, dampbji, dampcij, dampcji
 
   integer :: num_block_diag, num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n
   integer :: damporderij, damporderji
   integer  :: num_ions
 
   num_ion_types = size(ions,1)
   num_ions = ions(num_ion_types)%offset+ions(num_ion_types)%count
 
   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)
 
   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi
 
   !$acc data present(xyz_ions(:,:), type_ions(:), efield(:,:))
 
   ! Short range contribution
   ! ------------------------
   count_n = num_ions
   offset_n = 0
 
   ! Number of blocks with full interactions (below the diagonal
   num_block_full = localwork%pair_ion2ion_num_block_full_local_ms
   iblock_offset = localwork%pair_ion2ion_full_iblock_offset_ms
   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(dx, dy, dz, drnorm2, drnorm, &
      !$acc         eij, drnorm3rec, dampsumfi, xf, &
      !$acc         factorial, kk, dampexpi, dampfunci, dampsumfj, dampexpj, dampfuncj, &
      !$acc         itype, qi, &
      !$acc         jtype, qj, damporderji, dampbji, dampcji, damporderij, dampbij, dampcij)
      do i = istart, iend
         itype = type_ions(i)
         qi = ions(itype)%charge
         !$acc loop
         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 < ewald%rcutsq) then
               jtype = type_ions(j)
               qj = ions(jtype)%charge
               damporderji = tt%order(jtype,itype)
               dampbji=tt%b(jtype,itype)
               dampcji=tt%c(jtype,itype)
               damporderij = tt%order(itype,jtype)
               dampbij=tt%b(itype,jtype)
               dampcij=tt%c(itype,jtype)
               eij = elec_qmelt2mumelt_ij(drnorm2, alpha, alphasq, alphapi)
        
               drnorm = dsqrt(drnorm2)
               drnorm3rec = 1.0_wp/(drnorm*drnorm2)
        
               dampsumfi = 1.0_wp
               xf = 1.0_wp
               factorial = 1.0_wp
               do kk = 1, damporderji
                  xf = xf*dampbji*drnorm
                  factorial = factorial*float(kk)
                  dampsumfi = dampsumfi + (xf/factorial)
               enddo
               dampexpi = dexp(-dampbji*drnorm)
               dampfunci = -dampsumfi*dampexpi*dampcji*drnorm3rec
        
               !$acc atomic update
               efield(i,1) = efield(i,1) - qj*dx*(eij + dampfunci)
               !$acc atomic update
               efield(i,2) = efield(i,2) - qj*dy*(eij + dampfunci)
               !$acc atomic update
               efield(i,3) = efield(i,3) - qj*dz*(eij + dampfunci)
        
               dampsumfj = 1.0_wp
               xf = 1.0_wp
               factorial = 1.0_wp
               do kk = 1, damporderij
                  xf = xf*dampbij*drnorm
                  factorial = factorial*float(kk)
                  dampsumfj = dampsumfj + (xf/factorial)
               enddo
               dampexpj = dexp(-dampbij*drnorm)
               dampfuncj = -dampsumfj*dampexpj*dampcij*drnorm3rec
        
               !$acc atomic update
               efield(j,1) = efield(j,1) + qi*dx*(eij + dampfuncj)
               !$acc atomic update
               efield(j,2) = efield(j,2) + qi*dy*(eij + dampfuncj)
               !$acc atomic update
               efield(j,3) = efield(j,3) + qi*dz*(eij + dampfuncj)
            end if
         end do
         !$acc end loop
      end do
      !$acc end parallel loop
   end do
 
   ! Number of diagonal blocks
   num_block_diag = localwork%pair_ion2ion_num_block_diag_local_ms
   iblock_offset = localwork%pair_ion2ion_diag_iblock_offset_ms
   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(dx, dy, dz, drnorm2, drnorm, &
      !$acc         eij, drnorm3rec, dampsumfi, xf, &
      !$acc         factorial, kk, dampexpi, dampfunci, dampsumfj, dampexpj, dampfuncj, &
      !$acc         itype, qi, &
      !$acc         jtype, qj, damporderji, dampbji, dampcji, damporderij, dampbij, dampcij)
      do i = istart, iend
         itype = type_ions(i)
         qi = ions(itype)%charge
         !$acc loop
         do j = i+1, 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 < ewald%rcutsq) then
               jtype = type_ions(j)
               qj = ions(jtype)%charge
               damporderji = tt%order(jtype,itype)
               dampbji=tt%b(jtype,itype)
               dampcji=tt%c(jtype,itype)
               damporderij = tt%order(itype,jtype)
               dampbij=tt%b(itype,jtype)
               dampcij=tt%c(itype,jtype)
               eij = elec_qmelt2mumelt_ij(drnorm2, alpha, alphasq, alphapi)
        
               drnorm = dsqrt(drnorm2)
               drnorm3rec = 1.0_wp/(drnorm*drnorm2)
        
               dampsumfi = 1.0_wp
               xf = 1.0_wp
               factorial = 1.0_wp
               do kk = 1, damporderji
                  xf = xf*dampbji*drnorm
                  factorial = factorial*float(kk)
                  dampsumfi = dampsumfi + (xf/factorial)
               enddo
               dampexpi = dexp(-dampbji*drnorm)
               dampfunci = -dampsumfi*dampexpi*dampcji*drnorm3rec
        
               !$acc atomic update
               efield(i,1) = efield(i,1) - qj*dx*(eij + dampfunci)
               !$acc atomic update
               efield(i,2) = efield(i,2) - qj*dy*(eij + dampfunci)
               !$acc atomic update
               efield(i,3) = efield(i,3) - qj*dz*(eij + dampfunci)
        
               dampsumfj = 1.0_wp
               xf = 1.0_wp
               factorial = 1.0_wp
               do kk = 1, damporderij
                  xf = xf*dampbij*drnorm
                  factorial = factorial*float(kk)
                  dampsumfj = dampsumfj + (xf/factorial)
               enddo
               dampexpj = dexp(-dampbij*drnorm)
               dampfuncj = -dampsumfj*dampexpj*dampcij*drnorm3rec
        
               !$acc atomic update
               efield(j,1) = efield(j,1) + qi*dx*(eij + dampfuncj)
               !$acc atomic update
               efield(j,2) = efield(j,2) + qi*dy*(eij + dampfuncj)
               !$acc atomic update
               efield(j,3) = efield(j,3) + qi*dz*(eij + dampfuncj)
            end if
         end do
         !$acc end loop
      end do
      !$acc end parallel loop
   end do
   !$acc end data
 
end subroutine qmelt2mumelt_electricfield_@PBC@

!================================================================================
! Compute the electric fields felt by each melt ions due to other melt ions
subroutine mumelt2mumelt_electricfield_@PBC@(localwork, ewald, box, ions, xyz_ions, &
      efield, dipoles)
   implicit none
 
   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald          !< Ewald summation 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
   real(wp),             intent(in)    :: dipoles(:,:)  !< ions dipoles
 
   ! Parameters out
   ! --------------
   real(wp),             intent(inout) :: efield(:,:) !< Electric field on ions
 
   ! Local
   ! -----
   integer :: num_ion_types
   integer :: i, j, itype
   real(wp) :: a, b, c
   real(wp) :: muix, muiy, muiz, mujx, mujy, mujz !< ion dipole
   real(wp) :: drnorm2, dx, dy, dz
   real(wp) :: alpha, alphasq, alphapi
   real(wp), dimension(6) :: eij
 
   integer :: num_block_diag, num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n
 
   integer :: num_ions
 
   num_ions = 0
   num_ion_types = size(ions,1)
   do itype = 1,num_ion_types
      num_ions = num_ions + ions(itype)%count
   enddo
 
   count_n = num_ions
   offset_n = 0
 
   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)
 
   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi
 
   !$acc data present(xyz_ions(:,:), efield(:,:), dipoles(:,:))
 
   ! Short range contribution
   ! ------------------------
 
   ! Blocks on the diagonal compute only half of the pair interactions
   num_block_diag = localwork%pair_ion2ion_num_block_diag_local_ms
   iblock_offset = localwork%pair_ion2ion_diag_iblock_offset_ms

   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(muix, muiy, muiz, mujx, mujy, mujz, dx, dy, dz, drnorm2, eij(6))
      do i = istart, iend
         muix = dipoles(i,1)
         muiy = dipoles(i,2)
         muiz = dipoles(i,3)
         !$acc loop
         do j = i+1, 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 < ewald%rcutsq)) then
               mujx = dipoles(j,1)
               mujy = dipoles(j,2)
               mujz = dipoles(j,3)
               eij = elec_mumelt2mumelt_ij(drnorm2, dx, dy, dz, &
                    alpha, alphasq, alphapi, &
                    muix, muiy, muiz, mujx, mujy, mujz)
 
               !$acc atomic update
               efield(i,1) = efield(i,1) + eij(4)
               !$acc atomic update
               efield(i,2) = efield(i,2) + eij(5)
               !$acc atomic update
               efield(i,3) = efield(i,3) + eij(6)
 
               !$acc atomic update
               efield(j,1) = efield(j,1) + eij(1)
               !$acc atomic update
               efield(j,2) = efield(j,2) + eij(2)
               !$acc atomic update
               efield(j,3) = efield(j,3) + eij(3)
            end if
         end do
         !$acc end loop
      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_ms
   iblock_offset = localwork%pair_ion2ion_full_iblock_offset_ms
   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(muix, muiy, muiz, mujx, mujy, mujz, dx, dy, dz, drnorm2, eij(6))
      do i = istart, iend
         muix = dipoles(i,1)
         muiy = dipoles(i,2)
         muiz = dipoles(i,3)
         !$acc loop
         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 < ewald%rcutsq) then
               mujx = dipoles(j,1)
               mujy = dipoles(j,2)
               mujz = dipoles(j,3)
               eij = elec_mumelt2mumelt_ij(drnorm2, dx, dy, dz, &
                    alpha, alphasq, alphapi, &
                    muix, muiy, muiz, mujx, mujy, mujz)
 
               !$acc atomic update
               efield(i,1) = efield(i,1) + eij(4)
               !$acc atomic update
               efield(i,2) = efield(i,2) + eij(5)
               !$acc atomic update
               efield(i,3) = efield(i,3) + eij(6)
 
               !$acc atomic update
               efield(j,1) = efield(j,1) + eij(1)
               !$acc atomic update
               efield(j,2) = efield(j,2) + eij(2)
               !$acc atomic update
               efield(j,3) = efield(j,3) + eij(3)
            end if
         end do
         !$acc end loop
      end do
      !$acc end parallel loop
   end do
   !$acc end data
end subroutine mumelt2mumelt_electricfield_@PBC@

!================================================================================
! Compute the electric fields felt by each melt ions due to other melt ions
subroutine Qelec2mumelt_electricfield_@PBC@(localwork, ewald, box, ions, xyz_ions, &
      electrodes, xyz_atoms, q_elec, type_electrode_atoms, efield)
   implicit none
 
   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald          !< Ewald summation 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
   real(wp),             intent(in)    :: q_elec(:)      !< Electrode atoms charge
   integer,              intent(in)    :: type_electrode_atoms(:)
 
   ! Parameters out
   ! --------------
   real(wp),             intent(inout) :: efield(:,:) !< Electric field on ions
 
   ! Local
   ! -----
   integer :: num_ion_types, num_elec_types
   integer :: i, j
   real(wp) :: a, b, c
   real(wp) :: Q_j !< electrode charge
   real(wp) :: drnorm2, dx, dy, dz
   real(wp) :: alpha, alphasq, alphapi
   real(wp) :: etaj, etajsq, etajpi
   real(wp), dimension(3) :: eij
 
   integer :: num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n, count_m, offset_m
   integer  :: num_ions, num_elec_atoms
 
   num_ion_types = size(ions,1)
   num_elec_types = size(electrodes,1)
   num_ions = 0
   if (num_ion_types > 0) then
      num_ions = ions(num_ion_types)%offset+ions(num_ion_types)%count
   end if
   num_elec_atoms = 0
   if (num_elec_types > 0) then
      num_elec_atoms = electrodes(num_elec_types)%offset+electrodes(num_elec_types)%count
   end if
 
   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)
 
   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi
 
   !$acc data present(xyz_ions(:,:), xyz_atoms(:,:), q_elec(:), efield(:,:))
 
   ! Short range contribution
   ! ------------------------
   count_n = num_ions
   offset_n = 0
 
   count_m = num_elec_atoms
   offset_m = 0
 
   ! Number of blocks with full interactions (below the diagonal
   num_block_full = localwork%pair_ion2atom_num_block_full_local_ms
   iblock_offset = localwork%pair_ion2atom_full_iblock_offset_ms
 
   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 &
      !$acc private(dx, dy, dz, drnorm2, Q_j, eij(3))
      do i = istart, iend
         !$acc loop
         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 < ewald%rcutsq) then
               etaj = electrodes(type_electrode_atoms(j))%eta
               etajsq = etaj*etaj
               etajpi = 2.0_wp*etaj/sqrtpi
               Q_j = q_elec(j)
               eij = elec_Qelec2mumelt_ij(drnorm2, dx, dy, dz, &
                   alpha, alphasq, alphapi, etaj, etajsq, etajpi, Q_j)
               !$acc atomic update
               efield(i,1) = efield(i,1) - eij(1)
               !$acc atomic update
               efield(i,2) = efield(i,2) - eij(2)
               !$acc atomic update
               efield(i,3) = efield(i,3) - eij(3)
            end if
         end do
         !$acc end loop
      end do
      !$acc end parallel loop
   end do
   !$acc end data
end subroutine Qelec2mumelt_electricfield_@PBC@

!=========================================================================================
! Compute the electric field gradient felt by each melt ion due to other melt ion charges
subroutine melt_efg_pim_@PBC@(localwork, ewald, box, ions, xyz_ions, dipoles, efg)
   implicit none

   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald          !< Ewald summation 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
   real(wp),             intent(in)    :: dipoles(:,:)   !< ions dipoles

   ! Parameters out
   ! --------------
   real(wp),             intent(inout) :: efg(:,:)    !< Electric field gradient on ions


   ! Local
   ! -----
   integer :: num_ion_types
   integer :: i, j, itype, jtype, n
   logical :: itype_needs_efg, jtype_needs_efg
   real(wp) :: a, b, c
   real(wp) :: qi, qj !< ion charge
   real(wp) :: drnorm2, dx, dy, dz
   real(wp) :: alpha, alphasq, alphapi

   real(wp), dimension(3, 3)    :: tij_ab  ! local multipole tensor of rank 2
   real(wp), dimension(3, 3, 3) :: tij_abc ! local multipole tensor of rank 2
   real(wp), dimension(3) :: mui, muj

   integer :: num_block_diag, num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n, count_m, offset_m

   num_ion_types = size(ions,1)

   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi

   ! Short range contribution
   ! ------------------------
   do itype = 1, num_ion_types
      qi = ions(itype)%charge
      count_n = ions(itype)%count
      offset_n = ions(itype)%offset
      itype_needs_efg = ions(itype)%dump_efg

      do jtype = 1, itype - 1
         count_m = ions(jtype)%count
         offset_m = ions(jtype)%offset
         qj = ions(jtype)%charge
         jtype_needs_efg = ions(jtype)%dump_efg

         ! Run the computation if one of the types requires the electric field gradient.
         if ((ewald%sr_interaction_ion2ion(itype,jtype)) .and. &
             ((itype_needs_efg) .or. (jtype_needs_efg))) 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)
               do i = istart, iend
                  mui = dipoles(i,:)
                  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 < ewald%rcutsq) then
                        ! Compute the contribution from charges
                        call MW_multipole_tensors_tij_ab(drnorm2, dx, dy, dz, &
                                                         alpha, alphasq, alphapi, tij_ab)
                        ! Contribution on i (of type itype) due to j (of jtype)
                        if (itype_needs_efg) then
                           efg(i,1) = efg(i,1) - qj*tij_ab(1,1) ! txx
                           efg(i,2) = efg(i,2) - qj*tij_ab(1,2) ! txy
                           efg(i,3) = efg(i,3) - qj*tij_ab(1,3) ! txz
                           efg(i,4) = efg(i,4) - qj*tij_ab(2,2) ! tyy
                           efg(i,5) = efg(i,5) - qj*tij_ab(2,3) ! tyz
                           efg(i,6) = efg(i,6) - qj*tij_ab(3,3) ! tzz
                        end if
                        ! tij_ab is symmetric for i<->j
                        ! Contribution on j (of type jtype) due to i (of itype)
                        if (jtype_needs_efg) then
                           efg(j,1) = efg(j,1) - qi*tij_ab(1,1) ! txx
                           efg(j,2) = efg(j,2) - qi*tij_ab(1,2) ! txy
                           efg(j,3) = efg(j,3) - qi*tij_ab(1,3) ! txz
                           efg(j,4) = efg(j,4) - qi*tij_ab(2,2) ! tyy
                           efg(j,5) = efg(j,5) - qi*tij_ab(2,3) ! tyz
                           efg(j,6) = efg(j,6) - qi*tij_ab(3,3) ! tzz
                        end if

                        ! Compute the contribution from dipoles
                        muj = dipoles(j,:)
                        call MW_multipole_tensors_tij_abc(drnorm2, dx, dy, dz, &
                                                          alpha, alphasq, alphapi, tij_abc)
                        ! Contribution on i (of type itype) due to j (of jtype)
                        if (itype_needs_efg) then
                           do n = 1, 3
                              efg(i,1) = efg(i,1) + muj(n)*tij_abc(1,1,n)
                              efg(i,2) = efg(i,2) + muj(n)*tij_abc(1,2,n)
                              efg(i,3) = efg(i,3) + muj(n)*tij_abc(1,3,n)
                              efg(i,4) = efg(i,4) + muj(n)*tij_abc(2,2,n)
                              efg(i,5) = efg(i,5) + muj(n)*tij_abc(2,3,n)
                              efg(i,6) = efg(i,6) + muj(n)*tij_abc(3,3,n)
                           end do
                        end if
                        ! tij_abc is antisymmetric for i<->j
                        ! Contribution on j (of type jtype) due to i (of itype)
                        if (jtype_needs_efg) then
                           do n = 1, 3
                              efg(j,1) = efg(j,1) - mui(n)*tij_abc(1,1,n)
                              efg(j,2) = efg(j,2) - mui(n)*tij_abc(1,2,n)
                              efg(j,3) = efg(j,3) - mui(n)*tij_abc(1,3,n)
                              efg(j,4) = efg(j,4) - mui(n)*tij_abc(2,2,n)
                              efg(j,5) = efg(j,5) - mui(n)*tij_abc(2,3,n)
                              efg(j,6) = efg(j,6) - mui(n)*tij_abc(3,3,n)
                           end do
                        end if

                     end if ! Ewald cutoff
                  end do
               end do ! loop over all pairs in a given block
            end do ! loop over all blocks
         end if ! itype-jtype interaction flag
      end do ! loop over jtype < itype

      ! Run this computation only if itype requires the electric field gradient
      if (ewald%sr_interaction_ion2ion(itype,itype) .and. (itype_needs_efg)) then

         ! First, go over all diagonal blocks
         ! Blocks on the diagonal compute only half of the pair interactions
         qj = ions(itype)%charge
         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)
            do i = istart, iend
               mui = dipoles(i,:)
               do j = istart, iend
                  ! Compute the contribution from charges
                  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 < ewald%rcutsq)) then
                     call MW_multipole_tensors_tij_ab(drnorm2, dx, dy, dz, &
                                                      alpha, alphasq, alphapi, tij_ab)
                     ! Update only i but not j because we are on the diagonal, qj = qi
                     efg(i,1) = efg(i,1) - qj*tij_ab(1,1) ! txx
                     efg(i,2) = efg(i,2) - qj*tij_ab(1,2) ! txy
                     efg(i,3) = efg(i,3) - qj*tij_ab(1,3) ! txz
                     efg(i,4) = efg(i,4) - qj*tij_ab(2,2) ! tyy
                     efg(i,5) = efg(i,5) - qj*tij_ab(2,3) ! tyz
                     efg(i,6) = efg(i,6) - qj*tij_ab(3,3) ! tzz

                     ! Compute the contribution from dipoles
                     muj = dipoles(j,:)
                     call MW_multipole_tensors_tij_abc(drnorm2, dx, dy, dz, &
                                                       alpha, alphasq, alphapi, tij_abc)
                     ! Update only i but not j because we are on the diagonal, qj = qi
                     do n = 1, 3
                        efg(i,1) = efg(i,1) + muj(n)*tij_abc(1,1,n)
                        efg(i,2) = efg(i,2) + muj(n)*tij_abc(1,2,n)
                        efg(i,3) = efg(i,3) + muj(n)*tij_abc(1,3,n)
                        efg(i,4) = efg(i,4) + muj(n)*tij_abc(2,2,n)
                        efg(i,5) = efg(i,5) + muj(n)*tij_abc(2,3,n)
                        efg(i,6) = efg(i,6) + muj(n)*tij_abc(3,3,n)
                     end do
                  end if ! Ewald cutoff
               end do
            end do ! loop over all pairs in a given block
         end do ! loop over all _diagonal_ blocks

         ! Second, go over all off-diagonal blocks
         ! 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)
            do i = istart, iend
               mui = dipoles(i,:)
               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 < ewald%rcutsq) then
                     ! Compute the contribution from charges
                     call MW_multipole_tensors_tij_ab(drnorm2, dx, dy, dz, &
                                                      alpha, alphasq, alphapi, tij_ab)
                     ! Update i and j because we are off the diagonal, qj = qi
                     efg(i,1) = efg(i,1) - qj*tij_ab(1,1) ! txx
                     efg(i,2) = efg(i,2) - qj*tij_ab(1,2) ! txy
                     efg(i,3) = efg(i,3) - qj*tij_ab(1,3) ! txz
                     efg(i,4) = efg(i,4) - qj*tij_ab(2,2) ! tyy
                     efg(i,5) = efg(i,5) - qj*tij_ab(2,3) ! tyz
                     efg(i,6) = efg(i,6) - qj*tij_ab(3,3) ! tzz

                     efg(j,1) = efg(j,1) - qi*tij_ab(1,1) ! txx
                     efg(j,2) = efg(j,2) - qi*tij_ab(1,2) ! txy
                     efg(j,3) = efg(j,3) - qi*tij_ab(1,3) ! txz
                     efg(j,4) = efg(j,4) - qi*tij_ab(2,2) ! tyy
                     efg(j,5) = efg(j,5) - qi*tij_ab(2,3) ! tyz
                     efg(j,6) = efg(j,6) - qi*tij_ab(3,3) ! tzz

                     ! Compute the contribution from dipoles
                     muj = dipoles(j,:)
                     call MW_multipole_tensors_tij_abc(drnorm2, dx, dy, dz, &
                                                       alpha, alphasq, alphapi, tij_abc)
                     ! Contribution on i (of type itype) due to j (of jtype)
                     do n = 1, 3
                        efg(i,1) = efg(i,1) + muj(n)*tij_abc(1,1,n)
                        efg(i,2) = efg(i,2) + muj(n)*tij_abc(1,2,n)
                        efg(i,3) = efg(i,3) + muj(n)*tij_abc(1,3,n)
                        efg(i,4) = efg(i,4) + muj(n)*tij_abc(2,2,n)
                        efg(i,5) = efg(i,5) + muj(n)*tij_abc(2,3,n)
                        efg(i,6) = efg(i,6) + muj(n)*tij_abc(3,3,n)

                        ! tij_abc is antisymmetric for i<->j
                        efg(j,1) = efg(j,1) - mui(n)*tij_abc(1,1,n)
                        efg(j,2) = efg(j,2) - mui(n)*tij_abc(1,2,n)
                        efg(j,3) = efg(j,3) - mui(n)*tij_abc(1,3,n)
                        efg(j,4) = efg(j,4) - mui(n)*tij_abc(2,2,n)
                        efg(j,5) = efg(j,5) - mui(n)*tij_abc(2,3,n)
                        efg(j,6) = efg(j,6) - mui(n)*tij_abc(3,3,n)
                     end do

                  end if ! Ewald cutoff
               end do
            end do ! loop over all pairs in a given block
         end do ! loop over all _off diagonal_ blocks
      end if ! itype-itype interaction flag
   end do ! loop over all itype (melt ion types)

end subroutine melt_efg_pim_@PBC@

!================================================================================
! Compute the Coulomb forces felt by each melt ions due to other melt ions
subroutine melt_forces_pim_@PBC@(localwork, ewald, box, ions, xyz_ions, type_ions, &
      electrodes, xyz_atoms, type_electrode_atoms, q_elec, force, stress_tensor, dipoles, tt)
   implicit none

   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald           !< Ewald summation parameters
   type(MW_box_t),       intent(in)    :: box             !< Simulation box parameters
   type(MW_ion_t),       intent(in)    :: ions(:)         !< Ion parameters
   real(wp),             intent(in)    :: xyz_ions(:,:)   !< Ion xyz positions
   integer,              intent(in)    :: type_ions(:)    !< Ion types
   type(MW_electrode_t), intent(in)    :: electrodes(:)   !< Electrode parameters
   real(wp),             intent(in)    :: xyz_atoms(:,:)  !< Electrode atoms xyz positions
   integer,              intent(in)    :: type_electrode_atoms(:) !< Electrode atoms types
   real(wp),             intent(in)    :: q_elec(:)       !< Electrode atoms charge
   real(wp),             intent(in)    :: dipoles(:,:)    !< Ion dipoles
   type(MW_damping_t),   intent(in)    :: tt              !< Damping parameters

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

   ! Local
   ! -----
   integer :: num_ion_types, num_elec_types
   integer :: num_ions, num_elec_atoms
   integer :: i, j, itype, jtype
   integer :: orderij, orderji
   real(wp) :: a, b, c
   real(wp) :: qi, qj !< ion charge
   real(wp) :: muix, muiy, muiz, mujx, mujy, mujz !< ion dipole
   real(wp) :: Q_j !< electrode charges
   real(wp), dimension(3) :: fij
   real(wp) :: drnorm2, dx, dy, dz
   real(wp) :: alpha, alphasq, alphapi
   real(wp) :: etaj, etajsq, etajpi
   real(wp) :: bij, bji, cij, cji
   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

   integer :: num_block_diag, num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n, count_m, offset_m

   num_ion_types = size(ions,1)
   num_elec_types = size(electrodes,1)
   num_ions = 0
   if (num_ion_types > 0) then
      num_ions = ions(num_ion_types)%offset+ions(num_ion_types)%count
   end if
   num_elec_atoms = 0
   if (num_elec_types > 0) then
      num_elec_atoms = electrodes(num_elec_types)%offset+electrodes(num_elec_types)%count
   end if


   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)

   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi

   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, type_ions(:), xyz_atoms(:,:), type_electrode_atoms(:), q_elec(:), force(:,:),dipoles(:,:)) &
   !$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)

   ! Short range contribution
   ! ------------------------

   ! Blocks on the diagonal compute only half of the pair interactions
   num_block_diag = localwork%pair_ion2ion_num_block_diag_local_ms
   iblock_offset = localwork%pair_ion2ion_diag_iblock_offset_ms
   count_n = num_ions
   offset_n = 0

   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(muix, muiy, muiz, mujx, mujy, mujz, dx, dy, dz, drnorm2, fij(3), &
      !$acc         itype, jtype, qi, qj, bij, bji, orderij, orderji, cij, cji) reduction(+:loc_stress_tensor_xx, &
      !$acc                 loc_stress_tensor_yy, loc_stress_tensor_zz, loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)
      do i = istart, iend
         muix = dipoles(i,1)
         muiy = dipoles(i,2)
         muiz = dipoles(i,3)
         !$acc loop &
         !$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 j = i+1, iend  ! GPU optimization: run over half-blocks; for CPUs it used to be 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 < ewald%rcutsq)) then
               mujx = dipoles(j,1)
               mujy = dipoles(j,2)
               mujz = dipoles(j,3)

               itype = type_ions(i)
               jtype = type_ions(j)
               qi = ions(itype)%charge
               qj = ions(jtype)%charge

               bij = tt%b(itype,jtype)
               bji = tt%b(jtype,itype)
               orderij = tt%order(itype,jtype)
               orderji = tt%order(jtype,itype)
               cij = tt%c(itype,jtype)
               cji = tt%c(jtype,itype)

               fij = force_melt2melt_ij(drnorm2, dx, dy, dz,&
                      alpha, alphasq, alphapi, qi, qj,&
                      muix, muiy, muiz, mujx, mujy, mujz,&
                      bij, bji, orderij, orderji, cij, cji)

               ! GPU optimization: the following 6 lines need to be deleted when j runs from istart to iend
               !$acc atomic update
               force(i,1) = force(i,1) + fij(1)
               !$acc atomic update
               force(i,2) = force(i,2) + fij(2)
               !$acc atomic update
               force(i,3) = force(i,3) + fij(3)

               !$acc atomic update
               force(j,1) = force(j,1) - fij(1)
               !$acc atomic update
               force(j,2) = force(j,2) - fij(2)
               !$acc atomic update
               force(j,3) = force(j,3) - fij(3)

               ! GPU optimization: the stress contribution need to be divided by 2 when j runs from istart to iend
               loc_stress_tensor_xx = loc_stress_tensor_xx - dx * fij(1)
               loc_stress_tensor_yy = loc_stress_tensor_yy - dy * fij(2)
               loc_stress_tensor_zz = loc_stress_tensor_zz - dz * fij(3)
               loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * (dx * fij(2) + dy * fij(1))
               loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * (dx * fij(3) + dz * fij(1))
               loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * (dy * fij(3) + dz * fij(2))
            end if
         end do
         !$acc end loop
      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_ms
   iblock_offset = localwork%pair_ion2ion_full_iblock_offset_ms
   count_n = num_ions
   offset_n = 0

   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(muix, muiy, muiz, mujx, mujy, mujz, dx, dy, dz, drnorm2, fij(3), &
      !$acc         itype, jtype, qi, qj, bij, bji, orderij, orderji, cij, cji) reduction(+:loc_stress_tensor_xx, &
      !$acc                 loc_stress_tensor_yy, loc_stress_tensor_zz, loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)
      do i = istart, iend
         muix = dipoles(i,1)
         muiy = dipoles(i,2)
         muiz = dipoles(i,3)
         !$acc loop &
         !$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 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 < ewald%rcutsq) then
               mujx = dipoles(j,1)
               mujy = dipoles(j,2)
               mujz = dipoles(j,3)

               itype = type_ions(i)
               jtype = type_ions(j)
               qi = ions(itype)%charge
               qj = ions(jtype)%charge

               bij = tt%b(itype,jtype)
               bji = tt%b(jtype,itype)
               orderij = tt%order(itype,jtype)
               orderji = tt%order(jtype,itype)
               cij = tt%c(itype,jtype)
               cji = tt%c(jtype,itype)

               fij = force_melt2melt_ij(drnorm2, dx, dy, dz,&
                      alpha, alphasq, alphapi, qi, qj,&
                      muix, muiy, muiz, mujx, mujy, mujz, &
                      bij, bji, orderij, orderji, cij, cji)

               !$acc atomic update
               force(i,1) = force(i,1) + fij(1)
               !$acc atomic update
               force(i,2) = force(i,2) + fij(2)
               !$acc atomic update
               force(i,3) = force(i,3) + fij(3)

               !$acc atomic update
               force(j,1) = force(j,1) - fij(1)
               !$acc atomic update
               force(j,2) = force(j,2) - fij(2)
               !$acc atomic update
               force(j,3) = force(j,3) - fij(3)

               loc_stress_tensor_xx = loc_stress_tensor_xx - dx * fij(1)
               loc_stress_tensor_yy = loc_stress_tensor_yy - dy * fij(2)
               loc_stress_tensor_zz = loc_stress_tensor_zz - dz * fij(3)
               loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * (dx * fij(2) + dy * fij(1))
               loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * (dx * fij(3) + dz * fij(1))
               loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * (dy * fij(3) + dz * fij(2))
            end if
         end do
         !$acc end loop
      end do
      !$acc end parallel loop
   end do

   ! Number of blocks with full ion2atom interactions
   num_block_full = localwork%pair_ion2atom_num_block_full_local_ms
   iblock_offset = localwork%pair_ion2atom_full_iblock_offset_ms
   count_n = num_ions
   offset_n = 0
   count_m = num_elec_atoms
   offset_m = 0

   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 &
      !$acc private(muix, muiy, muiz, qi, Q_j, dx, dy, dz, drnorm2, fij(3), &
      !$acc         itype, jtype, etaj, etajsq, etajpi) reduction(+:loc_stress_tensor_xx, &
      !$acc                 loc_stress_tensor_yy, loc_stress_tensor_zz, loc_stress_tensor_xy, loc_stress_tensor_xz, loc_stress_tensor_yz)
      do i = istart, iend
         muix = dipoles(i,1)
         muiy = dipoles(i,2)
         muiz = dipoles(i,3)
         !$acc loop &
         !$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 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 < ewald%rcutsq) then
               itype = type_ions(i)
               jtype = type_electrode_atoms(j)

               etaj = electrodes(jtype)%eta
               etajsq = etaj*etaj
               etajpi = 2.0_wp*etaj/sqrtpi

               qi = ions(itype)%charge
               Q_j = q_elec(j)

               fij = force_elec2melt_ij(drnorm2, dx, dy, dz, &
                      alpha, alphasq, alphapi, etaj, etajsq, etajpi, &
                      qi, Q_j, muix, muiy, muiz)

               !$acc atomic update
               force(i,1) = force(i,1) + fij(1)
               !$acc atomic update
               force(i,2) = force(i,2) + fij(2)
               !$acc atomic update
               force(i,3) = force(i,3) + fij(3)

               loc_stress_tensor_xx = loc_stress_tensor_xx - dx * fij(1)
               loc_stress_tensor_yy = loc_stress_tensor_yy - dy * fij(2)
               loc_stress_tensor_zz = loc_stress_tensor_zz - dz * fij(3)
               loc_stress_tensor_xy = loc_stress_tensor_xy - 0.5_wp * (dx * fij(2) + dy * fij(1))
               loc_stress_tensor_xz = loc_stress_tensor_xz - 0.5_wp * (dx * fij(3) + dz * fij(1))
               loc_stress_tensor_yz = loc_stress_tensor_yz - 0.5_wp * (dy * fij(3) + dz * fij(2))
            end if
         end do
         !$acc end loop
      end do
      !$acc end parallel loop
   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_forces_pim_@PBC@

!================================================================================
! Compute the Energy due to Coulomb interactions
subroutine energy_pim_@PBC@(localwork, ewald, box, ions, xyz_ions, &
      electrodes, xyz_atoms, q_elec, h, dipoles, tt)
   use MW_constants, only: sqrt2
   implicit none
 
   ! Parameters in
   ! -------------
   type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
   type(MW_ewald_t),     intent(in)    :: ewald          !< Ewald summation 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
   real(wp),             intent(in)    :: q_elec(:)      !< Electrode atoms charge
   real(wp),             intent(in)    :: dipoles(:,:)  !< ions dipoles
   type(MW_damping_t),   intent(in)    :: tt             !< Damping parameters
 
   ! Parameters out
   ! --------------
   real(wp),             intent(inout) :: h !< Coulomb energy
 
   ! Local
   ! -----
   integer :: num_ion_types, num_elec_types
   integer :: i, j, itype, jtype
   integer :: orderij, orderji
   real(wp) :: a, b, c
   real(wp) :: qi, qj !< ion charge
   real(wp) :: Q_i, Q_j !< electrode charges
   real(wp) :: muix, muiy, muiz
   real(wp) :: mujx, mujy, mujz
   real(wp) :: bij, bji, cij, cji
   real(wp) :: erfdiff
   real(wp) :: vi, pot_ij
   real(wp) :: drnorm, drnorm2, rcutsq
   real(wp) :: dx, dy, dz
   real(wp) :: alpha, alphasq, alphapi
   real(wp) :: enerij
   real(wp) :: etai, etaj, etajsq, etajpi, etaij, etaijsq
 
   integer :: num_block_diag, num_block_full
   integer :: iblock, iblock_offset, istart, iend, jstart, jend
   integer :: count_n, offset_n, count_m, offset_m
 
   num_ion_types = size(ions,1)
   num_elec_types = size(electrodes,1)
 
   ! Precompute some factors
   ! -----------------------
   a = box%length(1)
   b = box%length(2)
   c = box%length(3)
 
   alpha = ewald%alpha
   alphasq = alpha*alpha
   alphapi = 2.0_wp*alpha/sqrtpi
 
   rcutsq = ewald%rcutsq
   ! Zero energy
   ! ----------------
   h = 0.0_wp
   vi = 0.0_wp
 
   !$acc data present(xyz_ions(:,:), xyz_atoms(:,:), dipoles(:,:), q_elec(:)) copy(vi)
 
   ! Short range contribution from Melt->Melt and Elec->Melt interaction
   ! -------------------------------------------------------------------
   do itype = 1, num_ion_types
      count_n = ions(itype)%count
      offset_n = ions(itype)%offset
      qi = ions(itype)%charge
      ! Here we compute qq, qmu and mumu interactions
      do jtype = 1, itype - 1
         count_m = ions(jtype)%count
         offset_m = ions(jtype)%offset
         qj = ions(jtype)%charge
         if (ewald%sr_interaction_ion2ion(itype,jtype)) 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  &
               !$acc private(muix, muiy, muiz, mujx, mujy, mujz, drnorm2, &
               !$acc         bij, bji, orderij, orderji, cij, cji, enerij) &
               !$acc reduction(+:vi)
               do i = istart, iend
                  muix = dipoles(i,1)
                  muiy = dipoles(i,2)
                  muiz = dipoles(i,3)
                  !$acc loop reduction(+:vi)
                  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
                        mujx = dipoles(j,1)
                        mujy = dipoles(j,2)
                        mujz = dipoles(j,3)
                        bij = tt%b(itype,jtype)
                        bji = tt%b(jtype,itype)
                        orderij = tt%order(itype,jtype)
                        orderji = tt%order(jtype,itype)
                        cij = tt%c(itype,jtype)
                        cji = tt%c(jtype,itype)
                        enerij = energy_melt2melt_ij(drnorm2, dx, dy, dz, &
                             alpha, alphasq, alphapi, qi, qj, &
                             muix, muiy, muiz, mujx, mujy, mujz, &
                             bij, bji, orderij, orderji, cij, cji)
                        vi = vi + enerij
                     end if
                  end do
                  !$acc end loop
               end do
               !$acc end parallel loop
            end do
         end if
      end do
 
      if (ewald%sr_interaction_ion2ion(itype,itype)) then
         ! Blocks on the diagonal compute only half of the pair interactions
         qj = ions(itype)%charge
         num_block_diag = localwork%pair_ion2ion_num_block_diag_local(itype)
         iblock_offset = localwork%pair_ion2ion_diag_iblock_offset(itype)
 
         bij = tt%b(itype,itype)
         bji = tt%b(itype,itype)
         orderij = tt%order(itype,itype)
         orderji = tt%order(itype,itype)
         cij = tt%c(itype,itype)
         cji = tt%c(itype,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(muix, muiy, muiz, mujx, mujy, mujz, drnorm2, &
            !$acc         enerij) &
            !$acc reduction(+:vi)
            do i = istart, iend
               muix = dipoles(i,1)
               muiy = dipoles(i,2)
               muiz = dipoles(i,3)
               !$acc loop reduction(+:vi)
               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
                     mujx = dipoles(j,1)
                     mujy = dipoles(j,2)
                     mujz = dipoles(j,3)
                     enerij = energy_melt2melt_ij(drnorm2, dx, dy, dz, &
                          alpha, alphasq, alphapi, qi, qj, &
                          muix, muiy, muiz, mujx, mujy, mujz, &
                          bij, bji, orderij, orderji, cij, cji)
                     vi = vi + 0.5_wp*enerij
                  end if
               end do
               !$acc end loop
            end do
            !$acc end parallel loop
         end do
 
         qi = ions(itype)%charge
         qj = ions(itype)%charge
         ! 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(muix, muiy, muiz, mujx, mujy, mujz, drnorm2, &
            !$acc         enerij) &
            !$acc reduction(+:vi)
            do i = istart, iend
               muix = dipoles(i,1)
               muiy = dipoles(i,2)
               muiz = dipoles(i,3)
               !$acc loop reduction(+:vi)
               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
                     mujx = dipoles(j,1)
                     mujy = dipoles(j,2)
                     mujz = dipoles(j,3)
                     enerij = energy_melt2melt_ij(drnorm2, dx, dy, dz, &
                          alpha, alphasq, alphapi, qi, qj, &
                          muix, muiy, muiz, mujx, mujy, mujz, &
                          bij, bji, orderij, orderji, cij, cji)
                     vi = vi + enerij
                  end if
               end do
               !$acc end loop
            end do
            !$acc end parallel loop
         end do
      end if
 
      ! Here we compute qQ and Qmu interaction
      ! We need damping functions for Qmu interaction.
      qi = ions(itype)%charge
      do jtype = 1, num_elec_types
         count_m = electrodes(jtype)%count
         offset_m = electrodes(jtype)%offset
         etaj = electrodes(jtype)%eta
         etajsq = etaj*etaj
         etajpi = 2.0_wp*etaj/sqrtpi
         if (ewald%sr_interaction_atom2ion(itype,jtype)) 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  &
               !$acc private(muix, muiy, muiz, Q_j, drnorm2) &
               !$acc reduction(+:vi)
               do i = istart, iend
                  muix = dipoles(i,1)
                  muiy = dipoles(i,2)
                  muiz = dipoles(i,3)
                  !$acc loop reduction(+:vi)
                  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
                        Q_j = q_elec(j)
                        vi = vi + energy_elec2melt_ij(drnorm2, dx, dy, dz, &
                            alpha, alphasq, alphapi, etaj, etajsq, etajpi, &
                            qi, Q_j, muix, muiy, muiz)
                     end if
                  end do
                  !$acc end loop
               end do
               !$acc end parallel loop
            end do
         end if
      end do
   end do
 
   ! Elec -> Elec interactions
   ! Here we compute QQ interactions
   do itype = 1, num_elec_types
      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
         if (ewald%sr_interaction_atom2atom(itype,jtype)) then
            etai = electrodes(itype)%eta
            etaj = electrodes(jtype)%eta
            etaij = (etai*etaj)/sqrt(etai*etai + etaj*etaj)
            etaijsq = etaij * etaij
 
            ! 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  &
               !$acc private(Q_i, Q_j, drnorm2, drnorm, erfdiff, pot_ij) &
               !$acc reduction(+:vi)
               do i = istart, iend
                  Q_i = q_elec(i)
                  !$acc loop reduction(+:vi)
                  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
                        Q_j = q_elec(j)
                        drnorm = sqrt(drnorm2)
                        ! Change erfc to 1-erf because of underflows
                        erfdiff = (erfc(alpha*drnorm) - erfc(etaij*drnorm))
                        pot_ij = erfdiff/drnorm
                        Vi = Vi + Q_i*Q_j*pot_ij
                     end if
                  end do
                  !$acc end loop
               end do
               !$acc end parallel loop
            end do
         end if
      end do
 
      if (ewald%sr_interaction_atom2atom(itype,itype)) then
 
         etai = electrodes(itype)%eta
         etaij = etai/sqrt2
         etaijsq = etaij*etaij
 
         ! Blocks on the diagonal compute only half of the pair interactions
         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  &
            !$acc private(Q_i, Q_j, drnorm2, drnorm, erfdiff, pot_ij) &
            !$acc reduction(+:vi)
            do i = istart, iend
               Q_i = q_elec(i)
               !$acc loop reduction(+:vi)
               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
                     Q_j = q_elec(j)
                     drnorm = sqrt(drnorm2)
                     erfdiff = (erfc(alpha*drnorm) - erfc(etaij*drnorm))
                     pot_ij =  erfdiff/drnorm
                     vi = vi + 0.5_wp*Q_i*Q_j*pot_ij
                  end if
               end do
               !$acc end loop
            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  &
            !$acc private(Q_i, Q_j, drnorm2, drnorm, erfdiff, pot_ij) &
            !$acc reduction(+:vi)
            do i = istart, iend
               Q_i = q_elec(i)
               !$acc loop reduction(+:vi)
               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
                     Q_j = q_elec(j)
                     drnorm = sqrt(drnorm2)
                     erfdiff = (erfc(alpha*drnorm) - erfc(etaij*drnorm))
                     pot_ij =  erfdiff/drnorm
                     vi = vi + Q_i*Q_j*pot_ij
                  end if
               end do
               !$acc end loop
            end do
            !$acc end parallel loop
         end do
      end if
   end do
   !$acc end data
   h = vi
end subroutine energy_pim_@PBC@
