mirror of https://gitlab.com/QEF/q-e.git
96 lines
2.8 KiB
Fortran
96 lines
2.8 KiB
Fortran
!
|
|
! Copyright (C) 2001 PWSCF group
|
|
! This file is distributed under the terms of the
|
|
! GNU General Public License. See the file `License'
|
|
! in the root directory of the present distribution,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
!
|
|
!----------------------------------------------------------------------
|
|
subroutine force_lc (nat, tau, ityp, alat, omega, ngm, ngl, &
|
|
igtongl, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, g, rho, nl, &
|
|
nspin, gstart, gamma_only, vloc, forcelc)
|
|
!----------------------------------------------------------------------
|
|
!
|
|
#include "f_defs.h"
|
|
USE kinds
|
|
implicit none
|
|
!
|
|
! first the dummy variables
|
|
!
|
|
integer :: nat, ngm, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, nspin, &
|
|
ngl, gstart, igtongl (ngm), nl (ngm), ityp (nat)
|
|
! input: the number of atoms in the cell
|
|
! input: the number of G vectors
|
|
! input: FFT dimensions
|
|
! input: number of spin polarizations
|
|
! input: the number of shells
|
|
! input: correspondence G <-> shell of G
|
|
! input: the correspondence fft mesh <-> G vec
|
|
! input: the types of atoms
|
|
|
|
logical :: gamma_only
|
|
|
|
real(DP) :: tau (3, nat), g (3, ngm), vloc (ngl, * ), &
|
|
rho (nrxx, nspin), alat, omega
|
|
! input: the coordinates of the atoms
|
|
! input: the coordinates of G vectors
|
|
! input: the local potential
|
|
! input: the valence charge
|
|
! input: the length measure
|
|
! input: the volume of the cell
|
|
|
|
real(DP) :: forcelc (3, nat)
|
|
! output: the local forces on atoms
|
|
|
|
integer :: ipol, ig, na
|
|
! counter on polarizations
|
|
! counter on G vectors
|
|
! counter on atoms
|
|
|
|
real(DP), allocatable :: aux (:,:)
|
|
! auxiliary space for FFT
|
|
real(DP) :: arg, fact
|
|
real(DP) , parameter :: tpi = 2.d0 * 3.14159265358979d0
|
|
!
|
|
! contribution to the force from the local part of the bare potential
|
|
! F_loc = Omega \Sum_G n*(G) d V_loc(G)/d R_i
|
|
!
|
|
allocate (aux(2, nrxx))
|
|
aux(1,:) = rho(:,1)
|
|
if (nspin.eq.2) aux(1,:) = aux(1,:) + rho(:,2)
|
|
aux(2,:) = 0.d0
|
|
call cft3 (aux, nr1, nr2, nr3, nrx1, nrx2, nrx3, - 1)
|
|
!
|
|
! aux contains now n(G)
|
|
!
|
|
if (gamma_only) then
|
|
fact = 2.d0
|
|
else
|
|
fact = 1.d0
|
|
end if
|
|
do na = 1, nat
|
|
do ipol = 1, 3
|
|
forcelc (ipol, na) = 0.d0
|
|
enddo
|
|
! contribution from G=0 is zero
|
|
do ig = gstart, ngm
|
|
arg = (g (1, ig) * tau (1, na) + g (2, ig) * tau (2, na) + &
|
|
g (3, ig) * tau (3, na) ) * tpi
|
|
do ipol = 1, 3
|
|
forcelc (ipol, na) = forcelc (ipol, na) + &
|
|
g (ipol, ig) * vloc (igtongl (ig), ityp (na) ) * &
|
|
(sin (arg) * aux(1,nl(ig)) + cos (arg) * aux(2,nl(ig)) )
|
|
enddo
|
|
enddo
|
|
do ipol = 1, 3
|
|
forcelc (ipol, na) = fact * forcelc (ipol, na) * omega * tpi / alat
|
|
enddo
|
|
enddo
|
|
#ifdef __PARA
|
|
call reduce (3 * nat, forcelc)
|
|
#endif
|
|
deallocate (aux)
|
|
return
|
|
end subroutine force_lc
|