! Module to compute long-range part of electrostatic (Coulomb) potential
module MW_coulomb_lr_pim
   use MW_kinds, only: wp
   use MW_ewald, only: MW_ewald_t
   use MW_box, only: MW_box_t
   use MW_constants, only: twopi, block_vector_size
   use MW_electrode, only: MW_electrode_t
   use MW_molecule, only: MW_molecule_t
   use MW_ion, only: MW_ion_t
   use MW_localwork, only: MW_localwork_t
   implicit none
   private

   ! Public subroutines
   ! ------------------
   public :: gradQelec_electricfield !grad_Q [grad_mu [U^lr_muQ]]
   public :: diag_gradmumelt_electricfield !diag[grad_mu [grad_mu [U^lr_mumu]]]
   public :: gradmumelt_electricfield !grad_mu [grad_mu [U^lr_mumu]]
   public :: mumelt2Qelec_potential !grad_Q [U^lr_muQ]
   public :: qmelt2mumelt_electricfield !-grad_mu [U^lr_qmu]
   public :: mumelt2mumelt_electricfield !-grad_mu [U^lr_mumu]
   public :: Qelec2mumelt_electricfield !-grad_mu [U^lr_muQ]
   public :: melt_efg !-grad_r grad_r [(U^lr_qq) + (U^lr_qmu) + (U^lr_mumu)]
   public :: melt_forces !-grad_r [(U^lr_qq + U^lr_qmu + U^lr_mumu) + (U^lr_QQ) + (U^lr_qQ + U^lr_muQ)]
   public :: energy !(U^lr_qq + U^lr_qmu + U^lr_mumu) + (U^lr_QQ) + (U^lr_qQ + U^lr_muQ)

contains

   subroutine gradQelec_electricfield(localwork, ewald, box, electrodes, &
      gradQ_efield)
      implicit none

      ! Parameters in
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      type(MW_box_t),       intent(in)    :: box             !< Simulation box parameters
      type(MW_electrode_t), intent(in)    :: electrodes(:)   !< electrodes parameters

      ! Parameters out
      ! --------------
      real(wp),             intent(inout) :: gradQ_efield(:,:)      !< Electric field on ions
      type(MW_ewald_t),     intent(inout) :: ewald           !< Ewald summation parameters

      ! Local
      ! -----
      integer :: num_ions, num_elec_types
      integer :: i, itype, j, jx, jy, jz
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky
      real(wp) :: cos_kxkykz_i, sin_kxkykz_i, cos_kxkykz_j, sin_kxkykz_j
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block, iend_type
      integer :: num_pbc

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

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_elec(:,0:kmax_x), ewald%sin_kx_elec(:,0:kmax_x), &
      !$acc        ewald%cos_ky_elec(:,0:kmax_y), ewald%sin_ky_elec(:,0:kmax_y), &
      !$acc        ewald%cos_kz_elec(:,0:kmax_z), ewald%sin_kz_elec(:,0:kmax_z), &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        gradQ_efield(:,:))

      volfactor = 2.0_wp/box%area(3)

      do itype = 1, num_elec_types
         num_blocks = 0
         if (electrodes(itype)%count > 0) then
            num_blocks = (electrodes(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = electrodes(itype)%offset + electrodes(itype)%count

         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + 1 + electrodes(itype)%offset
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
            !$acc         cos_kxkykz_i, sin_kxkykz_i, jx, jy, jz, cos_kxkykz_j, sin_kxkykz_j, &
            !$acc         i, j)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= ewald%knorm2_max) then

                  ! Atoms contribution to structure factor
                  Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

                  !$acc loop vector
                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_elec(i,l)
                     sin_kx = ewald%sin_kx_elec(i,l)
                     cos_ky = ewald%cos_ky_elec(i,mabs)
                     sin_ky = ewald%sin_ky_elec(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_elec(i,nabs)
                     sin_kz = ewald%sin_kz_elec(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz_i = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz_i = sin_kxky*cos_kz + cos_kxky*sin_kz

                     do j = 1, num_ions

                        jx = j
                        jy = j + num_ions
                        jz = j + num_ions*2

                        cos_kx = ewald%cos_kx_ions(j,l)
                        sin_kx = ewald%sin_kx_ions(j,l)
                        cos_ky = ewald%cos_ky_ions(j,mabs)
                        sin_ky = ewald%sin_ky_ions(j,mabs)*sign_m
                        cos_kz = ewald%cos_kz_ions(j,nabs)
                        sin_kz = ewald%sin_kz_ions(j,nabs)*sign_n

                        cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                        sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                        cos_kxkykz_j = cos_kxky*cos_kz - sin_kxky*sin_kz
                        sin_kxkykz_j = sin_kxky*cos_kz + cos_kxky*sin_kz

                        !$acc atomic update
                        gradQ_efield(jx,i) = gradQ_efield(jx,i) + Sk_alpha* &
                              (sin_kxkykz_i*cos_kxkykz_j - cos_kxkykz_i*sin_kxkykz_j)*kx
                        !$acc atomic update
                        gradQ_efield(jy,i) = gradQ_efield(jy,i) + Sk_alpha* &
                              (sin_kxkykz_i*cos_kxkykz_j - cos_kxkykz_i*sin_kxkykz_j)*ky
                        !$acc atomic update
                        gradQ_efield(jz,i) = gradQ_efield(jz,i) + Sk_alpha* &
                              (sin_kxkykz_i*cos_kxkykz_j - cos_kxkykz_i*sin_kxkykz_j)*kz

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

   end subroutine gradQelec_electricfield

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

      ! Parameters Input
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      type(MW_box_t),       intent(in)    :: box             !< Simulation box parameters
      type(MW_ion_t),       intent(in)    :: ions(:)         !< ions parameters

      ! Parameters Input/Output
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald              !< Ewald summation parameters
      real(wp),             intent(inout) :: diag_gradmu_efield(:) !< matrix containing the
      !< gradient of the field

      ! Local
      ! -----
      integer :: num_ion_types, num_ions
      integer :: i, itype, ix, iy, iz
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky
      real(wp) :: cos_kxkykz_i, sin_kxkykz_i
      real(wp) :: coskicoski_p_sinkisinki
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block, iend_type
      integer :: num_pbc

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

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_elec(:,0:kmax_x), ewald%sin_kx_elec(:,0:kmax_x), &
      !$acc        ewald%cos_ky_elec(:,0:kmax_y), ewald%sin_ky_elec(:,0:kmax_y), &
      !$acc        ewald%cos_kz_elec(:,0:kmax_z), ewald%sin_kz_elec(:,0:kmax_z), &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        ewald%Skmux_cos(:), &
      !$acc        ewald%Skmuy_cos(:), ewald%Skmux_sin(:), ewald%Skmuz_cos(:), &
      !$acc        ewald%Skmuy_sin(:), ewald%Skmuz_sin(:))

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 2.0_wp/box%area(3)

      ! Setup cache blocking parameters
      do itype = 1, num_ion_types

         num_blocks = 0
         if (ions(itype)%count > 0) then
            num_blocks = (ions(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = ions(itype)%offset + ions(itype)%count
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, &
            !$acc         cos_kxky, sin_kxky, cos_kxkykz_i, sin_kxkykz_i, i, &
            !$acc         coskicoski_p_sinkisinki)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= ewald%knorm2_max) then

                  Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

                  !$acc loop vector
                  do i = istart_block, iend_block

                     ix = i
                     iy = i + num_ions
                     iz = i + num_ions*2

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz_i = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz_i = sin_kxky*cos_kz + cos_kxky*sin_kz

                     coskicoski_p_sinkisinki = cos_kxkykz_i*cos_kxkykz_i + sin_kxkykz_i*sin_kxkykz_i ! Again, I think this is 1!

                     !Non-parallelized loop over all particles (not ready for non-polarizable species)

                     !$acc atomic update
                     diag_gradmu_efield(ix) = diag_gradmu_efield(ix) + &
                           Sk_alpha*coskicoski_p_sinkisinki*kx*kx !xx

                     !$acc atomic update
                     diag_gradmu_efield(iy) = diag_gradmu_efield(iy) + &
                           Sk_alpha*coskicoski_p_sinkisinki*ky*ky !yy

                     !$acc atomic update
                     diag_gradmu_efield(iz) = diag_gradmu_efield(iz) + &
                              Sk_alpha*coskicoski_p_sinkisinki*kz*kz !zz
                  end do ! ni
                  !$acc end loop
               end if
            end do ! imode
            !$acc end loop
            !$acc end parallel
         end do
      end do

      !$acc end data
   end subroutine diag_gradmumelt_electricfield

   !================================================================================
   ! 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(localwork, ewald, box, ions, &
         gradmu_efield)
      implicit none

      ! Parameters Input
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      type(MW_box_t),       intent(in)    :: box             !< Simulation box parameters
      type(MW_ion_t),       intent(in)    :: ions(:)         !< ions parameters

      ! Parameters Input/Output
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald              !< Ewald summation parameters
      real(wp),             intent(inout) :: gradmu_efield(:,:) !< matrix containing the
      !< gradient of the field

      ! Local
      ! -----
      integer :: num_ion_types, num_ions
      integer :: i, itype, j, ix, iy, iz, jx, jy, jz
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky
      real(wp) :: cos_kxkykz_i, sin_kxkykz_i, cos_kxkykz_j, sin_kxkykz_j
      real(wp) :: coskicoskj_p_sinkisinkj
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block, iend_type
      integer :: num_pbc

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

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        gradmu_efield(:,:))

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 2.0_wp/box%area(3)

      ! Setup cache blocking parameters
      do itype = 1, num_ion_types

         num_blocks = 0
         if (ions(itype)%count > 0) then
            num_blocks = (ions(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = ions(itype)%offset + ions(itype)%count
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, &
            !$acc         cos_kxky, sin_kxky, cos_kxkykz_i, sin_kxkykz_i, cos_kxkykz_j, sin_kxkykz_j, i, &
            !$acc         j, ix, iy, iz, jx, jy, jz, coskicoskj_p_sinkisinkj)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= ewald%knorm2_max) then

                  Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

                  !$acc loop vector
                  do i = istart_block, iend_block

                     ix = i
                     iy = i + num_ions
                     iz = i + num_ions*2

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz_i = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz_i = sin_kxky*cos_kz + cos_kxky*sin_kz

                     !Non-parallelized loop over all particles (not ready for non-polarizable species)
                     do j=1,i

                        jx = j
                        jy = j + num_ions
                        jz = j + num_ions*2

                        cos_kx = ewald%cos_kx_ions(j,l)
                        sin_kx = ewald%sin_kx_ions(j,l)
                        cos_ky = ewald%cos_ky_ions(j,mabs)
                        sin_ky = ewald%sin_ky_ions(j,mabs)*sign_m
                        cos_kz = ewald%cos_kz_ions(j,nabs)
                        sin_kz = ewald%sin_kz_ions(j,nabs)*sign_n

                        cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                        sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                        cos_kxkykz_j = cos_kxky*cos_kz - sin_kxky*sin_kz
                        sin_kxkykz_j = sin_kxky*cos_kz + cos_kxky*sin_kz

                        coskicoskj_p_sinkisinkj = cos_kxkykz_i*cos_kxkykz_j + sin_kxkykz_i*sin_kxkykz_j

                        !$acc atomic update
                        gradmu_efield(jx,ix) = gradmu_efield(jx,ix) + &
                              Sk_alpha*coskicoskj_p_sinkisinkj*kx*kx !xx
                        !$acc atomic update
                        gradmu_efield(jy,ix) = gradmu_efield(jy,ix) + &
                              Sk_alpha*coskicoskj_p_sinkisinkj*kx*ky !yx
                        !$acc atomic update
                        gradmu_efield(jz,ix) = gradmu_efield(jz,ix) + &
                              Sk_alpha*coskicoskj_p_sinkisinkj*kx*kz !zx

                        !$acc atomic update
                        gradmu_efield(jy,iy) = gradmu_efield(jy,iy) + &
                              Sk_alpha*coskicoskj_p_sinkisinkj*ky*ky !yy
                        !$acc atomic update
                        gradmu_efield(jz,iy) = gradmu_efield(jz,iy) + &
                              Sk_alpha*coskicoskj_p_sinkisinkj*ky*kz !zy

                        !$acc atomic update
                        gradmu_efield(jz,iz) = gradmu_efield(jz,iz) + &
                              Sk_alpha*coskicoskj_p_sinkisinkj*kz*kz !zz
                     end do
                  end do ! ni
                  !$acc end loop
               end if
            end do ! imode
            !$acc end loop
            !$acc end parallel
         end do
      end do

      !$acc end data
   end subroutine gradmumelt_electricfield

   !================================================================================
   ! Compute the long-range Coulomb potential felt by each electrode
   ! atoms due to all melt ions
   subroutine mumelt2Qelec_potential(localwork, ewald, box, &
      ions, electrodes, dipoles, V)
      implicit none

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

      ! Parameters out
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald      !< Ewald summation parameters
      real(wp),             intent(inout) :: V(:)       !< Coulomb potential

      ! Local
      ! -----
      integer :: num_ion_types, num_elec_types
      integer :: i
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: muix, muiy, muiz !< ion charge and dipoles
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: volfactor
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec
      real(wp) :: skmux_cos, skmux_sin
      real(wp) :: skmuy_cos, skmuy_sin
      real(wp) :: skmuz_cos, skmuz_sin
      real(wp) :: kdotmucos, kdotmusin

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block
      integer :: num_pbc
      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
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha * alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      volfactor = 2.0_wp/box%area(3)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_pbc = ewald%num_pbc

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        ewald%cos_kx_elec(:,0:kmax_x), ewald%sin_kx_elec(:,0:kmax_x), &
      !$acc        ewald%cos_ky_elec(:,0:kmax_y), ewald%sin_ky_elec(:,0:kmax_y), &
      !$acc        ewald%cos_kz_elec(:,0:kmax_z), ewald%sin_kz_elec(:,0:kmax_z), &
      !$acc        ewald%Skmux_cos(:), ewald%Skmux_sin, &
      !$acc        ewald%Skmuy_cos(:), ewald%Skmuy_sin, &
      !$acc        ewald%Skmuz_cos(:), ewald%Skmuz_sin, &
      !$acc        dipoles(:,:), V(:))

      ! Initiliaze potential to 0
      ! -------------------------
      !$acc kernels
      V(:) = 0.0_wp
      !$acc end kernels

      !$acc kernels
      ewald%Skmux_cos(:) = 0.0_wp
      ewald%Skmux_sin(:) = 0.0_wp
      ewald%Skmuy_cos(:) = 0.0_wp
      ewald%Skmuy_sin(:) = 0.0_wp
      ewald%Skmuz_cos(:) = 0.0_wp
      ewald%Skmuz_sin(:) = 0.0_wp
      !$acc end kernels

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes in the exectude globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank

      ! Setup cache blocking parameters
      num_blocks = (num_ions-1)/block_vector_size + 1
      do iblock = 1, num_blocks
         istart_block = (iblock-1)*block_vector_size + 1
         iend_block = min(istart_block+block_vector_size-1,num_ions)

         !$acc parallel
         !$acc loop gang &
         !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, &
         !$acc         skmux_cos, skmuy_cos, skmuz_cos, skmux_sin, skmuy_sin, skmuz_sin)
         do imode = 1, num_modes
            call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
            ! kx = l * twopi / box%length(1)
            kx = (real(l,wp)*twopi)*box_lengthx_rec
            ! ky = m*twopi / box%length(2)
            mabs = abs(m)
            sign_m = real(sign(1,m), wp)
            ky = (real(m,wp)*twopi)*box_lengthy_rec
            ! kz = zpoint(n)
            nabs = abs(n)
            sign_n = real(sign(1,n), wp)
            kz = ewald%zpoint(nabs)

            ! Norm square of the k-mode vector
            knorm2 = kx*kx + ky*ky + kz*kz
            if (knorm2 <= ewald%knorm2_max) then

               !Melt dipoles contribution to structure factor
               skmux_cos = 0.0_wp
               skmux_sin = 0.0_wp
               skmuy_cos = 0.0_wp
               skmuy_sin = 0.0_wp
               skmuz_cos = 0.0_wp
               skmuz_sin = 0.0_wp

               !$acc loop vector reduction(+: skmux_cos, skmuy_cos, skmuz_cos, skmux_sin, skmuy_sin, skmuz_sin) &
               !$acc private(muix, muiy, muiz, &
               !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
               !$acc         cos_kxkykz, sin_kxkykz)
               do i = istart_block, iend_block

                  muix = dipoles(i,1)
                  muiy = dipoles(i,2)
                  muiz = dipoles(i,3)

                  cos_kx = ewald%cos_kx_ions(i,l)
                  sin_kx = ewald%sin_kx_ions(i,l)
                  cos_ky = ewald%cos_ky_ions(i,mabs)
                  sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                  cos_kz = ewald%cos_kz_ions(i,nabs)
                  sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                  cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                  sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                  cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                  sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                  skmux_cos = skmux_cos + muix*cos_kxkykz
                  skmux_sin = skmux_sin + muix*sin_kxkykz
                  skmuy_cos = skmuy_cos + muiy*cos_kxkykz
                  skmuy_sin = skmuy_sin + muiy*sin_kxkykz
                  skmuz_cos = skmuz_cos + muiz*cos_kxkykz
                  skmuz_sin = skmuz_sin + muiz*sin_kxkykz

               end do
               !$acc end loop

               !Melt dipoles
               ewald%Skmux_cos(imode) = ewald%Skmux_cos(imode) + skmux_cos
               ewald%Skmux_sin(imode) = ewald%Skmux_sin(imode) + skmux_sin
               ewald%Skmuy_cos(imode) = ewald%Skmuy_cos(imode) + skmuy_cos
               ewald%Skmuy_sin(imode) = ewald%Skmuy_sin(imode) + skmuy_sin
               ewald%Skmuz_cos(imode) = ewald%Skmuz_cos(imode) + skmuz_cos
               ewald%Skmuz_sin(imode) = ewald%Skmuz_sin(imode) + skmuz_sin

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

      ! Setup cache blocking parameters
      num_blocks = (num_elec_atoms-1)/block_vector_size + 1
      do iblock = 1, num_blocks
         istart_block = (iblock-1)*block_vector_size + 1
         iend_block = min(istart_block+block_vector_size-1,num_elec_atoms)

         num_modes = localwork%ewald_num_mode_local
         l = localwork%ewald_kstart_x
         m = localwork%ewald_kstart_y
         n = localwork%ewald_kstart_z

         !$acc parallel
         !$acc loop gang &
         !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha)
         do imode = 1, num_modes
            call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
            ! kx = l * twopi / box%length(1)
            kx = (real(l,wp)*twopi)*box_lengthx_rec
            ! ky = m*twopi / box%length(2)
            mabs = abs(m)
            sign_m = real(sign(1,m), wp)
            ky = (real(m,wp)*twopi)*box_lengthy_rec
            ! kz = zpoint(n)
            nabs = abs(n)
            sign_n = real(sign(1,n), wp)
            kz = sign_n*ewald%zpoint(nabs)

            ! Norm square of the k-mode vector
            knorm2 = kx*kx + ky*ky + kz*kz
            if (knorm2 <= ewald%knorm2_max) then

               Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)
               !$acc loop vector &
               !$acc private(cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, &
               !$acc         cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz, i, &
               !$acc         kdotmucos, kdotmusin)
               do i = istart_block, iend_block

                  cos_kx = ewald%cos_kx_elec(i,l)
                  sin_kx = ewald%sin_kx_elec(i,l)
                  cos_ky = ewald%cos_ky_elec(i,mabs)
                  sin_ky = ewald%sin_ky_elec(i,mabs)*sign_m
                  cos_kz = ewald%cos_kz_elec(i,nabs)
                  sin_kz = ewald%sin_kz_elec(i,nabs)*sign_n

                  cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                  sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                  cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                  sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                  kdotmucos = ewald%Skmux_cos(imode)*kx + ewald%Skmuy_cos(imode)*ky + ewald%Skmuz_cos(imode)*kz   !rdotmuc in pimaim
                  kdotmusin = ewald%Skmux_sin(imode)*kx + ewald%Skmuy_sin(imode)*ky + ewald%Skmuz_sin(imode)*kz   !rdotmus in pimaim

                  !$acc atomic update
                  V(i) = V(i) + Sk_alpha*(sin_kxkykz*kdotmucos - cos_kxkykz*kdotmusin)
               end do
               !$acc end loop
            end if
         end do
         !$acc end loop
         !$acc end parallel
      end do
      !$acc end data
   end subroutine mumelt2Qelec_potential


   !================================================================================
   ! Compute the electric field felt by each melt ions due to other melt ions charges
   subroutine qmelt2mumelt_electricfield(localwork, ewald, box, ions, efield)
      implicit none

      ! Parameters in
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      type(MW_box_t),       intent(in)    :: box             !< Simulation box parameters
      type(MW_ion_t),       intent(in)    :: ions(:)         !< ions parameters

      ! Parameters out
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald           !< Ewald summation parameters
      real(wp),             intent(inout) :: efield(:,:) !< Electric field on ions

      ! Local
      ! -----
      integer :: num_ion_types
      integer :: i, itype
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: qi
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec
      real(wp) :: sk_cos, sk_sin

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block, iend_type
      integer :: num_pbc

      num_ion_types = size(ions,1)

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        ewald%Sk_cos(:), ewald%Sk_sin(:), efield(:,:))

      !$acc kernels
      ewald%Sk_cos(:) = 0.0_wp
      ewald%Sk_sin(:) = 0.0_wp
      !$acc end kernels

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 2.0_wp/box%area(3)

      !ions
      ! Setup cache blocking parameters
      do itype = 1, num_ion_types
         qi = ions(itype)%charge
         num_blocks = 0
         if (ions(itype)%count > 0) then
            num_blocks = (ions(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = ions(itype)%offset + ions(itype)%count
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
            !$acc         cos_kxkykz, sin_kxkykz, sk_cos, sk_sin, i)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m * twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= knorm2_max) then

                  ! Ions contribution to structure factor
                  sk_cos = 0.0_wp
                  sk_sin = 0.0_wp
                  !$acc loop vector reduction(+: sk_cos, sk_sin)
                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     sk_cos = sk_cos + qi*cos_kxkykz
                     sk_sin = sk_sin + qi*sin_kxkykz
                  end do
                  !$acc end loop
                  ewald%Sk_cos(imode) = ewald%Sk_cos(imode) + sk_cos
                  ewald%Sk_sin(imode) = ewald%Sk_sin(imode) + sk_sin

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

      !ions2ions
      ! Setup cache blocking parameters
      do itype = 1, num_ion_types
         qi = ions(itype)%charge

         num_blocks = 0
         if (ions(itype)%count > 0) then
            num_blocks = (ions(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = ions(itype)%offset + ions(itype)%count
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, &
            !$acc         cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz, i)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= ewald%knorm2_max) then

                  Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

                  !$acc loop vector
                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     ! electric field
                     !$acc atomic update
                     efield(i,1) = efield(i,1) +  kx*Sk_alpha*(sin_kxkykz*ewald%Sk_cos(imode) - cos_kxkykz*ewald%Sk_sin(imode))
                     !$acc atomic update
                     efield(i,2) = efield(i,2) +  ky*Sk_alpha*(sin_kxkykz*ewald%Sk_cos(imode) - cos_kxkykz*ewald%Sk_sin(imode))
                     !$acc atomic update
                     efield(i,3) = efield(i,3) +  kz*Sk_alpha*(sin_kxkykz*ewald%Sk_cos(imode) - cos_kxkykz*ewald%Sk_sin(imode))

                  end do ! ni
                  !$acc end loop
               end if
            end do ! imode
            !$acc end loop
            !$acc end parallel
         end do
      end do

      !$acc end data
   end subroutine qmelt2mumelt_electricfield

   !================================================================================
   ! Compute the electric fields felt by each melt ions due to other melt ions dipoles
   subroutine mumelt2mumelt_electricfield(localwork, ewald, box, ions, efield, dipoles)
      implicit none

      ! Parameters in
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      type(MW_box_t),       intent(in)    :: box             !< Simulation box parameters
      type(MW_ion_t),       intent(in)    :: ions(:)         !< ions parameters
      real(wp),             intent(in)    :: dipoles(:,:)       !< ions dipoles

      ! Parameters out
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald           !< Ewald summation parameters
      real(wp),             intent(inout) :: efield(:,:) !< Electric field on ions

      ! Local
      ! -----
      integer :: num_ion_types, num_ions
      integer :: i, itype
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec
      real(wp) :: skmux_cos, skmux_sin
      real(wp) :: skmuy_cos, skmuy_sin
      real(wp) :: skmuz_cos, skmuz_sin
      real(wp) :: kdotmucos,kdotmusin

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block
      integer :: num_pbc

      num_ion_types = size(ions,1)
      num_ions = 0
      do itype = 1, num_ion_types
         num_ions = num_ions+ions(itype)%count
      enddo

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        dipoles(:,:), &
      !$acc        ewald%Skmux_cos(:), &
      !$acc        ewald%Skmuy_cos(:), ewald%Skmux_sin(:), ewald%Skmuz_cos(:), &
      !$acc        ewald%Skmuy_sin(:), ewald%Skmuz_sin(:), &
      !$acc        efield(:,:))

      !$acc kernels
      ewald%Skmux_cos(:) = 0.0_wp
      ewald%Skmux_sin(:) = 0.0_wp
      ewald%Skmuy_cos(:) = 0.0_wp
      ewald%Skmuy_sin(:) = 0.0_wp
      ewald%Skmuz_cos(:) = 0.0_wp
      ewald%Skmuz_sin(:) = 0.0_wp
      !$acc end kernels

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 2.0_wp/box%area(3)

      ! Setup cache blocking parameters
         num_blocks = (num_ions-1)/block_vector_size + 1
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + 1
            iend_block = min(istart_block+block_vector_size-1,num_ions)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, &
            !$acc         skmux_cos, skmux_sin, &
            !$acc         skmuy_cos,skmuy_sin, skmuz_cos, skmuz_sin)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= knorm2_max) then

                  ! Ions contribution to structure factor
                  skmux_cos = 0.0_wp
                  skmux_sin = 0.0_wp
                  skmuy_cos = 0.0_wp
                  skmuy_sin = 0.0_wp
                  skmuz_cos = 0.0_wp
                  skmuz_sin = 0.0_wp
                  !$acc loop vector reduction(+: skmux_cos, skmux_sin, &
                  !$acc                skmuy_cos,skmuy_sin,skmuz_cos,skmuz_sin) &
                  !$acc private(cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
                  !$acc         cos_kxkykz, sin_kxkykz)
                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     skmux_cos = skmux_cos + dipoles(i,1)*cos_kxkykz
                     skmux_sin = skmux_sin + dipoles(i,1)*sin_kxkykz
                     skmuy_cos = skmuy_cos + dipoles(i,2)*cos_kxkykz
                     skmuy_sin = skmuy_sin + dipoles(i,2)*sin_kxkykz
                     skmuz_cos = skmuz_cos + dipoles(i,3)*cos_kxkykz
                     skmuz_sin = skmuz_sin + dipoles(i,3)*sin_kxkykz
                  end do
                  !$acc end loop
                  ewald%Skmux_cos(imode) = ewald%Skmux_cos(imode) + skmux_cos
                  ewald%Skmux_sin(imode) = ewald%Skmux_sin(imode) + skmux_sin
                  ewald%Skmuy_cos(imode) = ewald%Skmuy_cos(imode) + skmuy_cos
                  ewald%Skmuy_sin(imode) = ewald%Skmuy_sin(imode) + skmuy_sin
                  ewald%Skmuz_cos(imode) = ewald%Skmuz_cos(imode) + skmuz_cos
                  ewald%Skmuz_sin(imode) = ewald%Skmuz_sin(imode) + skmuz_sin

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

         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + 1
            iend_block = min(istart_block+block_vector_size-1,num_ions)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= ewald%knorm2_max) then

                  Sk_alpha =  2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

                  !$acc loop vector &
                  !$acc private(cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
                  !$acc         cos_kxkykz, sin_kxkykz, kdotmucos, kdotmusin)
                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     kdotmucos = ewald%Skmux_cos(imode)*kx + ewald%Skmuy_cos(imode)*ky + ewald%Skmuz_cos(imode)*kz   !rdotmuc in pimaim
                     kdotmusin = ewald%Skmux_sin(imode)*kx + ewald%Skmuy_sin(imode)*ky + ewald%Skmuz_sin(imode)*kz   !rdotmus in pimaim

                     ! electric field
                     !$acc atomic update
                     efield(i,1)  = efield(i,1) - Sk_alpha * (cos_kxkykz*kdotmucos + sin_kxkykz*kdotmusin)*kx
                     !$acc atomic update
                     efield(i,2)  = efield(i,2) - Sk_alpha * (cos_kxkykz*kdotmucos + sin_kxkykz*kdotmusin)*ky
                     !$acc atomic update
                     efield(i,3)  = efield(i,3) - Sk_alpha * (cos_kxkykz*kdotmucos + sin_kxkykz*kdotmusin)*kz

                  end do ! ni
                  !$acc end loop
               end if
            end do ! imode
            !$acc end loop
            !$acc end parallel
         end do

      !$acc end data
   end subroutine mumelt2mumelt_electricfield

   !================================================================================
   ! Compute the electric field felt by each melt ions due to other melt ions charges
   subroutine Qelec2mumelt_electricfield(localwork, ewald, box, ions, &
      electrodes, q_elec, efield)
      implicit none

      ! Parameters in
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      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)    :: q_elec(:)       !< Electrode atoms charge

      ! Parameters out
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald           !< Ewald summation parameters
      real(wp),             intent(inout) :: efield(:,:) !< Electric field on ions

      ! Local
      ! -----
      integer :: num_ion_types, num_elec_types
      integer :: i
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: Q_i !< electrode charges
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec
      real(wp) :: sk_cos, sk_sin

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block
      integer :: num_pbc
      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
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_elec(:,0:kmax_x), ewald%sin_kx_elec(:,0:kmax_x), &
      !$acc        ewald%cos_ky_elec(:,0:kmax_y), ewald%sin_ky_elec(:,0:kmax_y), &
      !$acc        ewald%cos_kz_elec(:,0:kmax_z), ewald%sin_kz_elec(:,0:kmax_z), &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        ewald%Sk_cos(:), ewald%Sk_sin(:), q_elec(:), efield(:,:))

      !$acc kernels
      ewald%Sk_cos(:) = 0.0_wp
      ewald%Sk_sin(:) = 0.0_wp
      !$acc end kernels

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 2.0_wp/box%area(3)

      !electrodes
      num_blocks = (num_elec_atoms-1)/block_vector_size + 1

      do iblock = 1, num_blocks
         istart_block = (iblock-1)*block_vector_size + 1
         iend_block = min(istart_block+block_vector_size-1,num_elec_atoms)

         !$acc parallel
         !$acc loop gang &
         !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, &
         !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
         !$acc         cos_kxkykz, sin_kxkykz, sk_cos, sk_sin, i, Q_i)
         do imode = 1, num_modes
            call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
            ! kx = l * twopi / box%length(1)
            kx = (real(l,wp)*twopi)*box_lengthx_rec
            ! ky = m*twopi / box%length(2)
            mabs = abs(m)
            sign_m = real(sign(1,m),wp)
            ky = (real(m,wp)*twopi)*box_lengthy_rec
            ! kz = zpoint(n)
            nabs = abs(n)
            sign_n = real(sign(1,n),wp)
            kz = sign_n*ewald%zpoint(nabs)

            ! Norm square of the k-mode vector
            knorm2 = kx*kx + ky*ky + kz*kz
            if (knorm2 <= ewald%knorm2_max) then
               sk_cos = 0.0_wp
               sk_sin = 0.0_wp
               ! Atoms contribution to structure factor
               !$acc loop vector reduction(+: sk_cos, sk_sin)
               do i = istart_block, iend_block
                  cos_kx = ewald%cos_kx_elec(i,l)
                  sin_kx = ewald%sin_kx_elec(i,l)
                  cos_ky = ewald%cos_ky_elec(i,mabs)
                  sin_ky = ewald%sin_ky_elec(i,mabs)*sign_m
                  cos_kz = ewald%cos_kz_elec(i,nabs)
                  sin_kz = ewald%sin_kz_elec(i,nabs)*sign_n

                  cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                  sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                  cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                  sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                  Q_i = q_elec(i)

                  sk_cos = sk_cos + Q_i*cos_kxkykz
                  sk_sin = sk_sin + Q_i*sin_kxkykz
               end do
               !$acc end loop
               ewald%Sk_cos(imode) = ewald%Sk_cos(imode) + sk_cos
               ewald%Sk_sin(imode) = ewald%Sk_sin(imode) + sk_sin
            end if
         end do ! imode
         !$acc end loop
         !$acc end parallel
      end do

      !electric field
      ! Setup cache blocking parameters
      num_blocks = (num_ions-1)/block_vector_size + 1
      do iblock = 1, num_blocks
         istart_block = (iblock-1)*block_vector_size + 1
         iend_block = min(istart_block+block_vector_size-1,num_ions)

         !$acc parallel
         !$acc loop gang &
         !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha, &
         !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, &
         !$acc         cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz, i)
         do imode = 1, num_modes
            call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
            ! kx = l * twopi / box%length(1)
            kx = (real(l,wp)*twopi)*box_lengthx_rec
            ! ky = m*twopi / box%length(2)
            mabs = abs(m)
            sign_m = real(sign(1,m),wp)
            ky = (real(m,wp)*twopi)*box_lengthy_rec
            ! kz = zpoint(n)
            nabs = abs(n)
            sign_n = real(sign(1,n),wp)
            kz = sign_n*ewald%zpoint(nabs)

            ! Norm square of the k-mode vector
            knorm2 = kx*kx + ky*ky + kz*kz
            if (knorm2 <= ewald%knorm2_max) then

               Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

               !$acc loop vector
               do i = istart_block, iend_block

                  cos_kx = ewald%cos_kx_ions(i,l)
                  sin_kx = ewald%sin_kx_ions(i,l)
                  cos_ky = ewald%cos_ky_ions(i,mabs)
                  sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                  cos_kz = ewald%cos_kz_ions(i,nabs)
                  sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                  cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                  sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                  cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                  sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                  ! electric field
                  !$acc atomic update
                  efield(i,1) = efield(i,1) + kx*Sk_alpha* &
                        (sin_kxkykz*ewald%Sk_cos(imode) - cos_kxkykz*ewald%Sk_sin(imode))
                  !$acc atomic update
                  efield(i,2) = efield(i,2) + ky*Sk_alpha* &
                        (sin_kxkykz*ewald%Sk_cos(imode) - cos_kxkykz*ewald%Sk_sin(imode))
                  !$acc atomic update
                  efield(i,3) = efield(i,3) + kz*Sk_alpha* &
                        (sin_kxkykz*ewald%Sk_cos(imode) - cos_kxkykz*ewald%Sk_sin(imode))

               end do ! ni
               !$acc end loop
            end if
         end do ! imode
         !$acc end loop
         !$acc end parallel
      end do

      !$acc end data
   end subroutine Qelec2mumelt_electricfield

   !================================================================================
   ! Compute the Coulomb forces felt by each melt ions due to other melt ions
   subroutine melt_forces(localwork, ewald, box, ions, &
      electrodes, q_elec, force, stress_tensor, dipoles)
      implicit none

      ! Parameters in
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      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)    :: q_elec(:)       !< Electrode atoms charge
      real(wp),             intent(in)    :: dipoles(:,:)       !< ions dipoles

      ! Parameters out
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald           !< Ewald summation parameters
      real(wp),             intent(inout) :: force(:,:) !< Coulomb force on ions
      real(wp),             intent(inout) :: stress_tensor(:,:) !< Coulomb force contribution to stress

      ! Local
      ! -----
      integer :: num_ion_types, num_elec_types
      integer :: i, itype
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: qi
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec
      real(wp) :: skq_cos, skq_sin
      real(wp) :: skmux_cos, skmux_sin
      real(wp) :: skmuy_cos, skmuy_sin
      real(wp) :: skmuz_cos, skmuz_sin
      real(wp) :: kdotmucos, kdotmusin
      real(wp) :: kdotmucosxx, kdotmusinxx
      real(wp) :: kdotmucosyy, kdotmusinyy
      real(wp) :: kdotmucoszz, kdotmusinzz
      real(wp) :: kdotmucosxy, kdotmusinxy
      real(wp) :: kdotmucosxz, kdotmusinxz
      real(wp) :: kdotmucosyz, kdotmusinyz
      real(wp) :: fqq, fqmu, fmuq, fmumu, ftot
      real(wp) :: stfac1,stfac2,qcos,qsin
      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 :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block, iend_type
      integer :: num_pbc


      num_ion_types = size(ions,1)
      num_elec_types = size(electrodes,1)

      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

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, &
      !$acc        ewald%cos_kx_elec(:,0:kmax_x), ewald%sin_kx_elec(:,0:kmax_x), &
      !$acc        ewald%cos_ky_elec(:,0:kmax_y), ewald%sin_ky_elec(:,0:kmax_y), &
      !$acc        ewald%cos_kz_elec(:,0:kmax_z), ewald%sin_kz_elec(:,0:kmax_z), &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        ewald%Sk_cos(:), ewald%Sk_sin(:), q_elec(:), force(:,:),dipoles(:,:), &
      !$acc        ewald%Skmux_cos(:), &
      !$acc        ewald%Skmuy_cos(:), ewald%Skmux_sin(:), ewald%Skmuz_cos(:), &
      !$acc        ewald%Skmuy_sin(:), ewald%Skmuz_sin(:)) &
      !$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 kernels
      ewald%Sk_cos(:) = 0.0_wp
      ewald%Sk_sin(:) = 0.0_wp
      ewald%Skmux_cos(:) = 0.0_wp
      ewald%Skmux_sin(:) = 0.0_wp
      ewald%Skmuy_cos(:) = 0.0_wp
      ewald%Skmuy_sin(:) = 0.0_wp
      ewald%Skmuz_cos(:) = 0.0_wp
      ewald%Skmuz_sin(:) = 0.0_wp
      !$acc end kernels

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 2.0_wp/box%area(3)

      ! Setup cache blocking parameters
      do itype = 1, num_ion_types
         qi = ions(itype)%charge

         num_blocks = 0
         if (ions(itype)%count > 0) then
            num_blocks = (ions(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = ions(itype)%offset + ions(itype)%count
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
            !$acc         cos_kxkykz, sin_kxkykz, skq_cos, skq_sin, skmux_cos, skmux_sin, &
            !$acc         skmuy_cos,skmuy_sin, skmuz_cos, skmuz_sin, i)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= knorm2_max) then

                  ! Ions contribution to structure factor
                  ! melt charges contribution
                  skq_cos = 0.0_wp
                  skq_sin = 0.0_wp
                  ! melt dipoles contribution
                  skmux_cos = 0.0_wp
                  skmux_sin = 0.0_wp
                  skmuy_cos = 0.0_wp
                  skmuy_sin = 0.0_wp
                  skmuz_cos = 0.0_wp
                  skmuz_sin = 0.0_wp
                  !$acc loop vector reduction(+: skq_cos, skq_sin, skmux_cos, skmux_sin, &
                  !$acc                       skmuy_cos,skmuy_sin,skmuz_cos,skmuz_sin)
                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     skq_cos = skq_cos + qi*cos_kxkykz
                     skq_sin = skq_sin + qi*sin_kxkykz

                     skmux_cos = skmux_cos + dipoles(i,1)*cos_kxkykz
                     skmux_sin = skmux_sin + dipoles(i,1)*sin_kxkykz
                     skmuy_cos = skmuy_cos + dipoles(i,2)*cos_kxkykz
                     skmuy_sin = skmuy_sin + dipoles(i,2)*sin_kxkykz
                     skmuz_cos = skmuz_cos + dipoles(i,3)*cos_kxkykz
                     skmuz_sin = skmuz_sin + dipoles(i,3)*sin_kxkykz
                  end do
                  !$acc end loop
                  ewald%Sk_cos(imode) = ewald%Sk_cos(imode) + skq_cos
                  ewald%Sk_sin(imode) = ewald%Sk_sin(imode) + skq_sin

                  ewald%Skmux_cos(imode) = ewald%Skmux_cos(imode) + skmux_cos
                  ewald%Skmux_sin(imode) = ewald%Skmux_sin(imode) + skmux_sin
                  ewald%Skmuy_cos(imode) = ewald%Skmuy_cos(imode) + skmuy_cos
                  ewald%Skmuy_sin(imode) = ewald%Skmuy_sin(imode) + skmuy_sin
                  ewald%Skmuz_cos(imode) = ewald%Skmuz_cos(imode) + skmuz_cos
                  ewald%Skmuz_sin(imode) = ewald%Skmuz_sin(imode) + skmuz_sin

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

      do itype = 1, num_elec_types
         num_blocks = 0
         if (electrodes(itype)%count > 0) then
            num_blocks = (electrodes(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = electrodes(itype)%offset + electrodes(itype)%count

         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + 1 + electrodes(itype)%offset
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
            !$acc         cos_kxkykz, sin_kxkykz, skq_cos, skq_sin, i)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= ewald%knorm2_max) then
                  ! electrode charges contribution
                  skq_cos = 0.0_wp
                  skq_sin = 0.0_wp
                  ! Atoms contribution to structure factor
                  !$acc loop vector reduction(+: skq_cos, skq_sin)
                  do i = istart_block, iend_block
                     cos_kx = ewald%cos_kx_elec(i,l)
                     sin_kx = ewald%sin_kx_elec(i,l)
                     cos_ky = ewald%cos_ky_elec(i,mabs)
                     sin_ky = ewald%sin_ky_elec(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_elec(i,nabs)
                     sin_kz = ewald%sin_kz_elec(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     skq_cos = skq_cos + q_elec(i)*cos_kxkykz
                     skq_sin = skq_sin + q_elec(i)*sin_kxkykz
                  end do
                  !$acc end loop
                  !Sk_cos/sin have inside the contribution of melt and electrodes charges
                  ewald%Sk_cos(imode) = ewald%Sk_cos(imode) + skq_cos
                  ewald%Sk_sin(imode) = ewald%Sk_sin(imode) + skq_sin
               end if
            end do ! imode
            !$acc end loop
            !$acc end parallel
         end do
      end do

      ! Setup cache blocking parameters
      do itype = 1, num_ion_types
         qi = ions(itype)%charge

         num_blocks = 0
         if (ions(itype)%count > 0) then
            num_blocks = (ions(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = ions(itype)%offset + ions(itype)%count
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            !$acc parallel
            !$acc loop gang &
            !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha, &
            !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, &
            !$acc         cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz, i, &
            !$acc         kdotmucos,kdotmusin,fqq,fqmu,fmuq,fmumu)
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m*twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= ewald%knorm2_max) then

                  Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

                  kdotmucos = ewald%Skmux_cos(imode)*kx + ewald%Skmuy_cos(imode)*ky + ewald%Skmuz_cos(imode)*kz   !rdotmuc in pimaim
                  kdotmusin = ewald%Skmux_sin(imode)*kx + ewald%Skmuy_sin(imode)*ky + ewald%Skmuz_sin(imode)*kz   !rdotmus in pimaim

                  !$acc loop vector
                  ! Computing forces over melt
                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     ! force on melt
                     !forces on point charges due to other point charges and electrode charges
                     fqq   = qi*Sk_alpha*(sin_kxkykz*ewald%Sk_cos(imode) - cos_kxkykz*ewald%Sk_sin(imode))
                     !forces on point charges due to point dipoles
                     fqmu  = qi*Sk_alpha*(-cos_kxkykz*kdotmucos - sin_kxkykz*kdotmusin)
                     !forces on point dipoles due to point charges and electrode charges
                     fmuq  = (dipoles(i,1)*kx + dipoles(i,2)*ky + dipoles(i,3)*kz)*Sk_alpha* &
                           (cos_kxkykz*ewald%Sk_cos(imode) + sin_kxkykz*ewald%Sk_sin(imode))
                     !forces on point dipoles due to other point dipoles
                     fmumu = (dipoles(i,1)*kx + dipoles(i,2)*ky + dipoles(i,3)*kz)*Sk_alpha* &
                           (-cos_kxkykz*kdotmusin + sin_kxkykz*kdotmucos)
                     ftot  = fqq + fqmu + fmuq + fmumu

                     !$acc atomic update
                     force(i,1) = force(i,1) + ftot*kx
                     !$acc atomic update
                     force(i,2) = force(i,2) + ftot*ky
                     !$acc atomic update
                     force(i,3) = force(i,3) + ftot*kz

                  end do ! ni
                  !$acc end loop
               end if
            end do ! imode
            !$acc end loop
            !$acc end parallel
         end do
      end do

      ! Setup cache blocking parameters
      !$acc parallel
      !$acc loop gang &
      !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, Sk_alpha, &
      !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, &
      !$acc         cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz, i, &
      !$acc         kdotmucos, kdotmusin, kdotmucosxx, kdotmusinxx, kdotmucosxy, kdotmusinxy,&
      !$acc         kdotmucosxz, kdotmusinxz, kdotmucosyy, kdotmusinyy, kdotmucosyz, kdotmusinyz, &
      !$acc         kdotmucoszz, kdotmusinzz, qcos, qsin, stfac1, stfac2) 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 imode = 1, num_modes
         call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
         ! kx = l * twopi / box%length(1)
         kx = (real(l,wp)*twopi)*box_lengthx_rec
         ! ky = m*twopi / box%length(2)
         mabs = abs(m)
         sign_m = real(sign(1,m),wp)
         ky = (real(m,wp)*twopi)*box_lengthy_rec
         ! kz = zpoint(n)
         nabs = abs(n)
         sign_n = real(sign(1,n),wp)
         kz = sign_n*ewald%zpoint(nabs)

         ! Norm square of the k-mode vector
         knorm2 = kx*kx + ky*ky + kz*kz
         if (knorm2 <= ewald%knorm2_max) then

            Sk_alpha = volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)  ! divided by 2 compared to forces

            qcos = ewald%Sk_cos(imode)
            qsin = ewald%Sk_sin(imode)
            kdotmucos = ewald%Skmux_cos(imode)*kx + ewald%Skmuy_cos(imode)*ky + ewald%Skmuz_cos(imode)*kz   !rdotmuc in pimaim
            kdotmusin = ewald%Skmux_sin(imode)*kx + ewald%Skmuy_sin(imode)*ky + ewald%Skmuz_sin(imode)*kz   !rdotmus in pimaim

            kdotmucosxx = ewald%Skmux_cos(imode)*kx
            kdotmusinxx = ewald%Skmux_sin(imode)*kx

            kdotmucosyy = ewald%Skmuy_cos(imode)*ky
            kdotmusinyy = ewald%Skmuy_sin(imode)*ky

            kdotmucoszz = ewald%Skmuz_cos(imode)*kz
            kdotmusinzz = ewald%Skmuz_sin(imode)*kz

            kdotmucosxy = 0.5_wp*(ewald%Skmux_cos(imode)*ky + ewald%Skmuy_cos(imode)*kx)
            kdotmusinxy = 0.5_wp*(ewald%Skmux_sin(imode)*ky + ewald%Skmuy_sin(imode)*kx)

            kdotmucosxz = 0.5_wp*(ewald%Skmux_cos(imode)*kz + ewald%Skmuz_cos(imode)*kx)
            kdotmusinxz = 0.5_wp*(ewald%Skmux_sin(imode)*kz + ewald%Skmuz_sin(imode)*kx)

            kdotmucosyz = 0.5_wp*(ewald%Skmuy_cos(imode)*kz + ewald%Skmuz_cos(imode)*ky)
            kdotmusinyz = 0.5_wp*(ewald%Skmuy_sin(imode)*kz + ewald%Skmuz_sin(imode)*ky)

            ! q q term
            stfac1 = (4.0_wp*alphasq+knorm2)/(4.0_wp*alphasq*knorm2)
            stfac2 = Sk_alpha * (qcos**2.0+qsin**2.0)

            loc_stress_tensor_xx=loc_stress_tensor_xx+ &
                     (1.0_wp-2.0_wp * kx * kx * stfac1)*stfac2
            loc_stress_tensor_yy=loc_stress_tensor_yy+ &
                     (1.0_wp-2.0_wp * ky * ky * stfac1)*stfac2
            loc_stress_tensor_zz=loc_stress_tensor_zz+ &
                     (1.0_wp-2.0_wp * kz * kz * stfac1)*stfac2
            loc_stress_tensor_xy=loc_stress_tensor_xy+ &
                     (-2.0_wp * kx * ky * stfac1)*stfac2
            loc_stress_tensor_xz=loc_stress_tensor_xz+ &
                     (-2.0_wp * kx * kz * stfac1)*stfac2
            loc_stress_tensor_yz=loc_stress_tensor_yz+ &
                     (-2.0_wp * ky * kz * stfac1)*stfac2

            ! q mu term
            stfac2 = 2.0_wp*Sk_alpha * (qsin * kdotmucos - qcos * kdotmusin)

            loc_stress_tensor_xx=loc_stress_tensor_xx+ &
                     (1.0_wp-2.0_wp * kx * kx * stfac1)*stfac2
            loc_stress_tensor_yy=loc_stress_tensor_yy+ &
                     (1.0_wp-2.0_wp * ky * ky * stfac1)*stfac2
            loc_stress_tensor_zz=loc_stress_tensor_zz+ &
                     (1.0_wp-2.0_wp * kz * kz * stfac1)*stfac2
            loc_stress_tensor_xy=loc_stress_tensor_xy+ &
                     (-2.0_wp * kx * ky * stfac1)*stfac2
            loc_stress_tensor_xz=loc_stress_tensor_xz+ &
                     (-2.0_wp * kx * kz * stfac1)*stfac2
            loc_stress_tensor_yz=loc_stress_tensor_yz+ &
                     (-2.0_wp * ky * kz * stfac1)*stfac2

            stfac2 = 2.0_wp*Sk_alpha * (qsin * kdotmucosxx - qcos * kdotmusinxx)
            loc_stress_tensor_xx=loc_stress_tensor_xx+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (qsin * kdotmucosyy - qcos * kdotmusinyy)
            loc_stress_tensor_yy=loc_stress_tensor_yy+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (qsin * kdotmucoszz - qcos * kdotmusinzz)
            loc_stress_tensor_zz=loc_stress_tensor_zz+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (qsin * kdotmucosxy - qcos * kdotmusinxy)
            loc_stress_tensor_xy=loc_stress_tensor_xy+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (qsin * kdotmucosxz - qcos * kdotmusinxz)
            loc_stress_tensor_xz=loc_stress_tensor_xz+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (qsin * kdotmucosyz - qcos * kdotmusinyz)
            loc_stress_tensor_yz=loc_stress_tensor_yz+stfac2

            ! mu mu term
            stfac2 = Sk_alpha * (kdotmucos**2.0 + kdotmusin**2.0)

            loc_stress_tensor_xx=loc_stress_tensor_xx+ &
                     (1.0_wp-2.0_wp * kx * kx * stfac1)*stfac2
            loc_stress_tensor_yy=loc_stress_tensor_yy+ &
                     (1.0_wp-2.0_wp * ky * ky * stfac1)*stfac2
            loc_stress_tensor_zz=loc_stress_tensor_zz+ &
                     (1.0_wp-2.0_wp * kz * kz * stfac1)*stfac2
            loc_stress_tensor_xy=loc_stress_tensor_xy+ &
                     (-2.0_wp * kx * ky * stfac1)*stfac2
            loc_stress_tensor_xz=loc_stress_tensor_xz+ &
                     (-2.0_wp * kx * kz * stfac1)*stfac2
            loc_stress_tensor_yz=loc_stress_tensor_yz+ &
                     (-2.0_wp * ky * kz * stfac1)*stfac2

            stfac2 = 2.0_wp*Sk_alpha * (kdotmucos * kdotmucosxx + kdotmusin * kdotmusinxx)
            loc_stress_tensor_xx=loc_stress_tensor_xx+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (kdotmucos * kdotmucosyy + kdotmusin * kdotmusinyy)
            loc_stress_tensor_yy=loc_stress_tensor_yy+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (kdotmucos * kdotmucoszz + kdotmusin * kdotmusinzz)
            loc_stress_tensor_zz=loc_stress_tensor_zz+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (kdotmucos * kdotmucosxy + kdotmusin * kdotmusinxy)
            loc_stress_tensor_xy=loc_stress_tensor_xy+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (kdotmucos * kdotmucosxz + kdotmusin * kdotmusinxz)
            loc_stress_tensor_xz=loc_stress_tensor_xz+stfac2

            stfac2 = 2.0_wp*Sk_alpha * (kdotmucos * kdotmucosyz + kdotmusin * kdotmusinyz)
            loc_stress_tensor_yz=loc_stress_tensor_yz+stfac2

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

      !$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

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

      ! Parameters in
      ! -------------
      type(MW_localwork_t), intent(in)    :: localwork       !< Local work assignment
      type(MW_box_t),       intent(in)    :: box             !< Simulation box parameters
      type(MW_ion_t),       intent(in)    :: ions(:)         !< ions parameters
      real(wp),             intent(in)    :: dipoles(:,:)    !< ions dipoles

      ! Parameters out
      ! --------------
      type(MW_ewald_t),     intent(inout) :: ewald           !< Ewald summation parameters
      real(wp),             intent(inout) :: efg(:,:)        !< Electric field on ions

      ! Local
      ! -----
      integer :: num_ion_types
      integer :: i, itype
      logical :: itype_needs_efg
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: qi
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_alpha !< Structure factor coefficients
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec
      real(wp) :: skq_cos, skq_sin
      real(wp) :: skmux_cos, skmuy_cos, skmuz_cos
      real(wp) :: skmux_sin, skmuy_sin, skmuz_sin
      real(wp) :: kdotmusin, kdotmucos
      real(wp) :: efg_imode, efg_q_imode, efg_mu_imode

      integer :: imode, num_modes, mode_offset
      integer :: iblock, num_blocks, istart_block, iend_block, iend_type
      integer :: num_pbc

      num_ion_types = size(ions,1)

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      ! Zero the arrays for sums of sin and cos before the computation.
      ewald%Sk_cos(:) = 0.0_wp
      ewald%Sk_sin(:) = 0.0_wp
      ewald%Skmux_cos(:) = 0.0_wp
      ewald%Skmux_sin(:) = 0.0_wp
      ewald%Skmuy_cos(:) = 0.0_wp
      ewald%Skmuy_sin(:) = 0.0_wp
      ewald%Skmuz_cos(:) = 0.0_wp
      ewald%Skmuz_sin(:) = 0.0_wp

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 2.0_wp/box%area(3)

      ! Ions: cache thu sums over sin and cos.
      ! Setup cache blocking parameters
      do itype = 1, num_ion_types
         qi = ions(itype)%charge
         num_blocks = 0
         if (ions(itype)%count > 0) then
            num_blocks = (ions(itype)%count-1)/block_vector_size + 1
         end if
         iend_type = ions(itype)%offset + ions(itype)%count
         do iblock = 1, num_blocks
            istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
            iend_block = min(istart_block+block_vector_size-1,iend_type)

            ! Each processor works on its part of modes in parallel.
            do imode = 1, num_modes
               call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
               ! kx = l * twopi / box%length(1)
               kx = (real(l,wp)*twopi)*box_lengthx_rec
               ! ky = m * twopi / box%length(2)
               mabs = abs(m)
               sign_m = real(sign(1,m),wp)
               ky = (real(m,wp)*twopi)*box_lengthy_rec
               ! kz = zpoint(n)
               nabs = abs(n)
               sign_n = real(sign(1,n),wp)
               kz = sign_n*ewald%zpoint(nabs)

               ! Norm square of the k-mode vector
               knorm2 = kx*kx + ky*ky + kz*kz
               if (knorm2 <= knorm2_max) then

                  ! Ions contribution to structure factor
                  ! melt charges contribution
                  skq_cos = 0.0_wp
                  skq_sin = 0.0_wp
                  ! melt dipoles contribution
                  skmux_cos = 0.0_wp
                  skmux_sin = 0.0_wp
                  skmuy_cos = 0.0_wp
                  skmuy_sin = 0.0_wp
                  skmuz_cos = 0.0_wp
                  skmuz_sin = 0.0_wp

                  do i = istart_block, iend_block

                     cos_kx = ewald%cos_kx_ions(i,l)
                     sin_kx = ewald%sin_kx_ions(i,l)
                     cos_ky = ewald%cos_ky_ions(i,mabs)
                     sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                     cos_kz = ewald%cos_kz_ions(i,nabs)
                     sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                     cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                     sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                     cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                     sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                     skq_cos = skq_cos + qi*cos_kxkykz
                     skq_sin = skq_sin + qi*sin_kxkykz

                     skmux_cos = skmux_cos + dipoles(i,1)*cos_kxkykz
                     skmux_sin = skmux_sin + dipoles(i,1)*sin_kxkykz
                     skmuy_cos = skmuy_cos + dipoles(i,2)*cos_kxkykz
                     skmuy_sin = skmuy_sin + dipoles(i,2)*sin_kxkykz
                     skmuz_cos = skmuz_cos + dipoles(i,3)*cos_kxkykz
                     skmuz_sin = skmuz_sin + dipoles(i,3)*sin_kxkykz
                  end do
                  ewald%Sk_cos(imode) = ewald%Sk_cos(imode) + skq_cos
                  ewald%Sk_sin(imode) = ewald%Sk_sin(imode) + skq_sin

                  ewald%Skmux_cos(imode) = ewald%Skmux_cos(imode) + skmux_cos
                  ewald%Skmux_sin(imode) = ewald%Skmux_sin(imode) + skmux_sin
                  ewald%Skmuy_cos(imode) = ewald%Skmuy_cos(imode) + skmuy_cos
                  ewald%Skmuy_sin(imode) = ewald%Skmuy_sin(imode) + skmuy_sin
                  ewald%Skmuz_cos(imode) = ewald%Skmuz_cos(imode) + skmuz_cos
                  ewald%Skmuz_sin(imode) = ewald%Skmuz_sin(imode) + skmuz_sin

               end if
            end do ! imode
         end do
      end do

      ! Compute the contribution to the electric field gradient on ion positions.
      ! Setup cache blocking parameters
      do itype = 1, num_ion_types
         qi = ions(itype)%charge
         itype_needs_efg = ions(itype)%dump_efg

         ! Run the computation for selected ion types only
         if (itype_needs_efg) then
            num_blocks = 0
            if (ions(itype)%count > 0) then
               num_blocks = (ions(itype)%count-1)/block_vector_size + 1
            end if
            iend_type = ions(itype)%offset + ions(itype)%count
            do iblock = 1, num_blocks
               istart_block = (iblock-1)*block_vector_size + ions(itype)%offset + 1
               iend_block = min(istart_block+block_vector_size-1,iend_type)

               do imode = 1, num_modes
                  call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
                  ! kx = l * twopi / box%length(1)
                  kx = (real(l,wp)*twopi)*box_lengthx_rec
                  ! ky = m*twopi / box%length(2)
                  mabs = abs(m)
                  sign_m = real(sign(1,m),wp)
                  ky = (real(m,wp)*twopi)*box_lengthy_rec
                  ! kz = zpoint(n)
                  nabs = abs(n)
                  sign_n = real(sign(1,n),wp)
                  kz = sign_n*ewald%zpoint(nabs)

                  ! Norm square of the k-mode vector
                  knorm2 = kx*kx + ky*ky + kz*kz
                  if (knorm2 <= ewald%knorm2_max) then

                     Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)

                     kdotmucos = ewald%Skmux_cos(imode)*kx + ewald%Skmuy_cos(imode)*ky + ewald%Skmuz_cos(imode)*kz   !rdotmucos
                     kdotmusin = ewald%Skmux_sin(imode)*kx + ewald%Skmuy_sin(imode)*ky + ewald%Skmuz_sin(imode)*kz   !rdotmusin

                     do i = istart_block, iend_block
                        cos_kx = ewald%cos_kx_ions(i,l)
                        sin_kx = ewald%sin_kx_ions(i,l)
                        cos_ky = ewald%cos_ky_ions(i,mabs)
                        sin_ky = ewald%sin_ky_ions(i,mabs)*sign_m
                        cos_kz = ewald%cos_kz_ions(i,nabs)
                        sin_kz = ewald%sin_kz_ions(i,nabs)*sign_n

                        cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                        sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                        cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                        sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                        ! The efg prefactor for a fixed k-vector
                        ! Contribution due to charges
                        efg_q_imode = Sk_alpha*(sin_kxkykz*ewald%Sk_sin(imode) + &
                                                cos_kxkykz*ewald%Sk_cos(imode))

                        ! Contribution due to dipoles
                        efg_mu_imode = Sk_alpha*(sin_kxkykz*kdotmucos - &
                                                 cos_kxkykz*kdotmusin)
                        efg_imode = efg_q_imode + efg_mu_imode

                        ! Electric field gradient components
                        efg(i,1) = efg(i,1) + kx*kx*efg_imode ! xx
                        efg(i,2) = efg(i,2) + kx*ky*efg_imode ! xy
                        efg(i,3) = efg(i,3) + kx*kz*efg_imode ! xz
                        efg(i,4) = efg(i,4) + ky*ky*efg_imode ! yy
                        efg(i,5) = efg(i,5) + ky*kz*efg_imode ! yz
                        efg(i,6) = efg(i,6) + kz*kz*efg_imode ! zz

                     end do ! ni
                  end if
               end do ! imode
            end do
         end if ! itype_needs_efg
      end do

   end subroutine melt_efg

   !================================================================================
   ! Compute the contibution to the energy from long-range Coulomb interaction
   subroutine energy(localwork, ewald, box, ions, &
      electrodes, q_elec, h, 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
      type(MW_electrode_t), intent(in) :: electrodes(:)   !< electrodes parameters
      real(wp),             intent(in) :: q_elec(:)       !< Electrode atoms charge
      real(wp),             intent(in) :: dipoles(:,:)    !< ions dipoles

      ! Parameters out
      ! --------------
      real(wp), intent(inout) :: h !< energy

      ! Local
      ! -----
      integer :: num_ion_types, num_elec_types
      integer :: i, itype, iion
      integer :: l, m, n, mabs, nabs
      integer :: kmax_x, kmax_y, kmax_z
      real(wp) :: sign_m, sign_n
      real(wp) :: qi
      real(wp) :: kx, ky, kz, knorm2, knorm2_max
      real(wp) :: Sk_cos, Sk_sin, Sk_alpha , Sk_cos_type, Sk_sin_type !< Structure factor coefficients
      real(wp) :: Skmu_cos,Skmu_sin,Skmu_cos_type,Skmu_sin_type
      real(wp) :: kdotmu
      real(wp) :: cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz
      real(wp) :: cos_kxky, sin_kxky, cos_kxkykz, sin_kxkykz
      real(wp) :: volfactor
      real(wp) :: alpha, alphasq, alphaconst
      real(wp) :: box_lengthx_rec, box_lengthy_rec

      integer :: imode, num_modes, mode_offset
      integer :: num_pbc

      num_ion_types = size(ions,1)
      num_elec_types = size(electrodes,1)

      ! Precompute some factors
      ! -----------------------
      alpha = ewald%alpha
      alphasq = alpha*alpha
      alphaconst = -1.0_wp/(4.0_wp*alphasq)

      num_pbc = ewald%num_pbc
      box_lengthx_rec = 1.0_wp/box%length(1)
      box_lengthy_rec = 1.0_wp/box%length(2)

      knorm2_max = ewald%knorm2_max
      kmax_x = ewald%kmax_x
      kmax_y = ewald%kmax_y
      kmax_z = ewald%kmax_z

      num_modes = localwork%ewald_num_mode_local
      mode_offset = localwork%ewald_local_mode_offset

      !$acc data &
      !$acc present(ewald, ewald%zpoint, ewald%zweight, ions(:), electrodes(:), &
      !$acc        ewald%cos_kx_elec(:,0:kmax_x), ewald%sin_kx_elec(:,0:kmax_x), &
      !$acc        ewald%cos_ky_elec(:,0:kmax_y), ewald%sin_ky_elec(:,0:kmax_y), &
      !$acc        ewald%cos_kz_elec(:,0:kmax_z), ewald%sin_kz_elec(:,0:kmax_z), &
      !$acc        ewald%cos_kx_ions(:,0:kmax_x), ewald%sin_kx_ions(:,0:kmax_x), &
      !$acc        ewald%cos_ky_ions(:,0:kmax_y), ewald%sin_ky_ions(:,0:kmax_y), &
      !$acc        ewald%cos_kz_ions(:,0:kmax_z), ewald%sin_kz_ions(:,0:kmax_z), &
      !$acc        q_elec(:), dipoles(:,:)) copy(h)

      ! Long range contribution is computed in reciprocal space
      ! -------------------------------------------------------
      ! The sum over k-modes is symmetric
      !   -> we loop only on half of them and mulitply by 2.0
      ! Total number of modes
      !    (2*kmax_x+1)*(2*kmax_y+1)*nz
      ! Num modes executed globally
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz
      ! Num modes executed by the local process (approx.)
      !    (2*kmax_x*kmax_y + kmax_x + kmax_y)*nz / num_rank
      volfactor = 1.0_wp/box%area(3)

      !$acc parallel
      !$acc loop gang &
      !$acc private(imode, l, m, n, kx, ky, kz, mabs, nabs, sign_m, sign_n, knorm2, &
      !$acc         cos_kx, sin_kx, cos_ky, sin_ky, cos_kz, sin_kz, cos_kxky, sin_kxky, &
      !$acc         cos_kxkykz, sin_kxkykz, i, qi, Sk_alpha, &
      !$acc         Sk_cos, Sk_sin, Skmu_cos, Skmu_sin, Sk_cos_type, Sk_sin_type, &
      !$acc         Skmu_cos_type, Skmu_sin_type, kdotmu) &
      !$acc reduction(+:h)
      do imode = 1, num_modes
         call compute_kmode_index(num_pbc, kmax_x, kmax_y, kmax_z, imode+mode_offset, l, m, n)
         ! kx = l * twopi / box%length(1)
         kx = (real(l,wp)*twopi)*box_lengthx_rec
         ! ky = m*twopi / box%length(2)
         mabs = abs(m)
         sign_m = real(sign(1,m),wp)
         ky = (real(m,wp)*twopi)*box_lengthy_rec
         ! kz = zpoint(n)
         nabs = abs(n)
         sign_n = real(sign(1,n),wp)
         kz = sign_n*ewald%zpoint(nabs)

         ! Norm square of the k-mode vector
         knorm2 = kx*kx + ky*ky + kz*kz
         if (knorm2 <= ewald%knorm2_max) then
            !Melt charges
            Sk_cos = 0.0_wp
            Sk_sin = 0.0_wp
            !Melt dipoles
            Skmu_cos = 0.0_wp
            Skmu_sin = 0.0_wp
            ! Melt contribution to structure factor
            !$acc loop seq
            do itype = 1, num_ion_types
               qi = ions(itype)%charge
               Sk_cos_type = 0.0_wp
               Sk_sin_type = 0.0_wp
               Skmu_cos_type = 0.0_wp
               Skmu_sin_type = 0.0_wp
               !$acc loop vector reduction(+: Sk_cos_type, Sk_sin_type, Skmu_cos_type, Skmu_sin_type)
               do i = 1, ions(itype)%count
                  iion = ions(itype)%offset + i
                  cos_kx = ewald%cos_kx_ions(iion,l)
                  sin_kx = ewald%sin_kx_ions(iion,l)
                  cos_ky = ewald%cos_ky_ions(iion,mabs)
                  sin_ky = ewald%sin_ky_ions(iion,mabs)*sign_m
                  cos_kz = ewald%cos_kz_ions(iion,nabs)
                  sin_kz = ewald%sin_kz_ions(iion,nabs)*sign_n

                  cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                  sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                  cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                  sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                  Sk_cos_type = Sk_cos_type + qi*cos_kxkykz
                  Sk_sin_type = Sk_sin_type + qi*sin_kxkykz

                  kdotmu = dipoles(iion,1)*kx + dipoles(iion,2)*ky + dipoles(iion,3)*kz

                  Skmu_cos_type = Skmu_cos_type + kdotmu*cos_kxkykz
                  Skmu_sin_type = Skmu_sin_type + kdotmu*sin_kxkykz
               end do
               !$acc end loop
               Sk_cos = Sk_cos + Sk_cos_type
               Sk_sin = Sk_sin + Sk_sin_type
               Skmu_cos = Skmu_cos + Skmu_cos_type
               Skmu_sin = Skmu_sin + Skmu_sin_type
            end do
            !$acc end loop

            ! Electrodes contribution to structure factor
            !$acc loop seq
            do itype = 1, num_elec_types
               !Electrode charges
               Sk_cos_type = 0.0_wp
               Sk_sin_type = 0.0_wp
               !$acc loop vector reduction(+: Sk_cos_type, Sk_sin_type)
               do i = 1, electrodes(itype)%count
                  iion = electrodes(itype)%offset + i
                  cos_kx = ewald%cos_kx_elec(iion,l)
                  sin_kx = ewald%sin_kx_elec(iion,l)
                  cos_ky = ewald%cos_ky_elec(iion,mabs)
                  sin_ky = ewald%sin_ky_elec(iion,mabs)*sign_m
                  cos_kz = ewald%cos_kz_elec(iion,nabs)
                  sin_kz = ewald%sin_kz_elec(iion,nabs)*sign_n

                  cos_kxky = cos_kx*cos_ky - sin_kx*sin_ky
                  sin_kxky = sin_kx*cos_ky + cos_kx*sin_ky

                  cos_kxkykz = cos_kxky*cos_kz - sin_kxky*sin_kz
                  sin_kxkykz = sin_kxky*cos_kz + cos_kxky*sin_kz

                  Sk_cos_type = Sk_cos_type + q_elec(iion)*cos_kxkykz
                  Sk_sin_type = Sk_sin_type + q_elec(iion)*sin_kxkykz
               end do
               !$acc end loop
               Sk_cos = Sk_cos + Sk_cos_type
               Sk_sin = Sk_sin + Sk_sin_type
            end do
            !$acc end loop
            Sk_alpha = 2.0_wp*volfactor*ewald%zweight(nabs)*(exp(alphaconst*knorm2)/knorm2)
            !Sk_cos/sin have inside the contribution of melt and electrodes charges
            !E = (q+Q)*(q+Q) + (q+Q)*mu + mu*mu
            h = h + Sk_alpha*(Sk_cos*Sk_cos + Sk_sin*Sk_sin + &
                  2.0_wp*Sk_sin*Skmu_cos - 2.0_wp*Sk_cos*Skmu_sin + &
                  Skmu_cos*Skmu_cos + Skmu_sin*Skmu_sin)
         end if
      end do ! imode
      !$acc end loop
      !$acc end parallel
      !$acc end data
   end subroutine energy

   include 'update_kmode_index.inc'

end module MW_coulomb_lr_pim
