2003-01-20 05:58:50 +08:00
|
|
|
!
|
2009-08-03 17:19:02 +08:00
|
|
|
! Copyright (C) 2001-2007 Quantum ESPRESSO group
|
2003-01-20 05:58:50 +08:00
|
|
|
! 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 .
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
subroutine addcore (mode, drhoc)
|
2004-01-15 23:50:19 +08:00
|
|
|
!
|
|
|
|
! This routine computes the change of the core charge
|
|
|
|
! when the atoms moves along the given mode
|
|
|
|
!
|
|
|
|
!
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2004-01-23 23:08:03 +08:00
|
|
|
USE kinds, only : DP
|
2007-10-29 18:20:01 +08:00
|
|
|
use uspp_param, only: upf
|
2004-06-12 21:44:18 +08:00
|
|
|
use ions_base, only: nat, ityp
|
2004-04-02 18:30:15 +08:00
|
|
|
use cell_base, only: tpiba
|
2010-08-28 21:48:36 +08:00
|
|
|
use fft_base, only: dfftp
|
|
|
|
use fft_interfaces, only: invfft
|
2010-12-05 21:07:09 +08:00
|
|
|
use gvect, only: ngm, nl, mill, eigts1, eigts2, eigts3, g
|
2004-01-15 23:50:19 +08:00
|
|
|
use modes, only: u
|
|
|
|
use qpoint, only: eigqts, xq
|
|
|
|
use nlcc_ph, only: nlcc_any, drc
|
|
|
|
implicit none
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2004-01-15 23:50:19 +08:00
|
|
|
!
|
|
|
|
! The dummy variables
|
|
|
|
!
|
|
|
|
integer, intent (IN) :: mode
|
|
|
|
! input: the mode
|
2010-10-26 16:28:22 +08:00
|
|
|
complex(DP), intent(OUT) :: drhoc (dfftp%nnr)
|
2004-01-15 23:50:19 +08:00
|
|
|
! output: the change of the core charge
|
|
|
|
!
|
|
|
|
! Local variables
|
|
|
|
!
|
|
|
|
integer :: nt, ig, mu, na
|
2005-08-28 22:09:42 +08:00
|
|
|
complex(DP) :: fact, gu, gu0, u1, u2, u3, gtau
|
2004-01-15 23:50:19 +08:00
|
|
|
!
|
|
|
|
!
|
|
|
|
if (.not.nlcc_any) return
|
|
|
|
!
|
|
|
|
! compute the derivative of the core charge along the given mode
|
|
|
|
!
|
|
|
|
drhoc(:) = (0.d0, 0.d0)
|
|
|
|
do na = 1, nat
|
|
|
|
nt = ityp (na)
|
2007-10-29 18:20:01 +08:00
|
|
|
if (upf(nt)%nlcc) then
|
2004-05-06 21:06:16 +08:00
|
|
|
fact = tpiba * (0.d0, -1.d0) * eigqts (na)
|
2004-01-15 23:50:19 +08:00
|
|
|
mu = 3 * (na - 1)
|
|
|
|
if ( abs (u (mu + 1, mode) ) + &
|
|
|
|
abs (u (mu + 2, mode) ) + &
|
|
|
|
abs (u (mu + 3, mode) ) > 1.0d-12) then
|
|
|
|
u1 = u (mu + 1, mode)
|
|
|
|
u2 = u (mu + 2, mode)
|
|
|
|
u3 = u (mu + 3, mode)
|
|
|
|
gu0 = xq (1) * u1 + xq (2) * u2 + xq (3) * u3
|
|
|
|
do ig = 1, ngm
|
2010-12-05 21:07:09 +08:00
|
|
|
gtau = eigts1 (mill (1,ig), na) * eigts2 (mill (2,ig), na) &
|
|
|
|
* eigts3 (mill (3,ig), na)
|
2004-01-15 23:50:19 +08:00
|
|
|
gu = gu0 + g (1, ig) * u1 + g (2, ig) * u2 + g (3, ig) &
|
|
|
|
* u3
|
|
|
|
drhoc (nl (ig) ) = drhoc (nl (ig) ) + drc (ig, nt) * gu * &
|
|
|
|
fact * gtau
|
|
|
|
enddo
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
enddo
|
|
|
|
!
|
|
|
|
! transform to real space
|
|
|
|
!
|
2010-08-28 21:48:36 +08:00
|
|
|
CALL invfft ('Dense', drhoc, dfftp)
|
2004-01-15 23:50:19 +08:00
|
|
|
!
|
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
end subroutine addcore
|