2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! 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 .
|
|
|
|
|
!
|
|
|
|
|
!-----------------------------------------------------------------------
|
2003-02-08 00:04:36 +08:00
|
|
|
subroutine add_zstar_ue (imode0, npe)
|
2003-01-20 05:58:50 +08:00
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
! add the contribution of the modes imode0+1 -> imode+npe
|
|
|
|
|
! to the effective charges Z(Us,E) (Us=scf,E=bare)
|
|
|
|
|
!
|
|
|
|
|
! trans =.true. is needed for this calculation to be meaningful
|
|
|
|
|
!
|
|
|
|
|
#include "machine.h"
|
2003-02-08 00:04:36 +08:00
|
|
|
use pwcom
|
2003-10-03 22:01:11 +08:00
|
|
|
USE wavefunctions, ONLY: evc
|
2003-02-08 00:04:36 +08:00
|
|
|
use parameters, only : DP
|
|
|
|
|
use phcom
|
|
|
|
|
implicit none
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
integer :: imode0, npe
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
integer :: ibnd, jpol, ipert, nrec, mode, ik
|
2003-01-20 05:58:50 +08:00
|
|
|
! counter on bands
|
|
|
|
|
! counter on polarization
|
|
|
|
|
! counter on pertubations
|
|
|
|
|
! counter on records
|
|
|
|
|
! counter on modes
|
|
|
|
|
! counter on k points
|
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
real(kind=DP) :: weight
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
complex(kind=DP) :: ZDOTC
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
if (nksq.gt.1) rewind (iunigk)
|
|
|
|
|
do ik = 1, nksq
|
|
|
|
|
if (nksq.gt.1) read (iunigk) npw, igk
|
|
|
|
|
npwq = npw
|
|
|
|
|
weight = wk (ik)
|
|
|
|
|
if (nksq.gt.1) call davcio (evc, lrwfc, iuwfc, ik, - 1)
|
|
|
|
|
call init_us_2 (npw, igk, xk (1, ik), vkb)
|
|
|
|
|
do jpol = 1, 3
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! recalculate DeltaV*psi(bare) for electric field
|
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
call dvpsi_e (ik, jpol)
|
2003-10-16 22:39:25 +08:00
|
|
|
!
|
|
|
|
|
! In the case of USPP we save dvpsi on disc
|
|
|
|
|
! We need this later for the aditional term.
|
|
|
|
|
!
|
|
|
|
|
if (okvan) then
|
|
|
|
|
nrec = (jpol-1) * nksq + ik
|
|
|
|
|
call davcio (dvpsi, lrbar, iubar, nrec, 1)
|
|
|
|
|
end if
|
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
do ipert = 1, npe
|
|
|
|
|
mode = imode0 + ipert
|
|
|
|
|
nrec = (ipert - 1) * nksq + ik
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! read DeltaV*psi(scf) for phonon mode # mode
|
|
|
|
|
!
|
|
|
|
|
|
2003-06-30 14:58:08 +08:00
|
|
|
call davcio (dpsi, lrdwf, iudwf, nrec, -1)
|
2003-02-08 00:04:36 +08:00
|
|
|
do ibnd = 1, nbnd
|
2003-01-20 05:58:50 +08:00
|
|
|
zstarue0 (mode, jpol) = zstarue0 (mode, jpol) - 2.d0 * weight * &
|
|
|
|
|
ZDOTC (npw, dpsi (1, ibnd), 1, dvpsi (1, ibnd), 1)
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
end subroutine add_zstar_ue
|
