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 stres_knl (sigmanlc, sigmakin)
|
2003-01-20 05:58:50 +08:00
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
!
|
2004-06-26 01:25:37 +08:00
|
|
|
#include "f_defs.h"
|
2007-02-21 21:01:31 +08:00
|
|
|
USE kinds, ONLY: DP
|
2004-01-15 23:50:19 +08:00
|
|
|
USE constants, ONLY: pi, e2
|
2007-02-21 21:01:31 +08:00
|
|
|
USE cell_base, ONLY: omega, alat, at, bg, tpiba
|
2004-01-15 23:50:19 +08:00
|
|
|
USE gvect, ONLY: qcutz, ecfixed, q2sigma, g
|
2007-01-23 00:38:47 +08:00
|
|
|
USE klist, ONLY: nks, xk, ngk
|
2004-01-15 23:50:19 +08:00
|
|
|
USE io_files, ONLY: iunwfc, nwordwfc, iunigk
|
2007-02-21 21:01:31 +08:00
|
|
|
USE buffers, ONLY: get_buffer
|
2004-01-15 23:50:19 +08:00
|
|
|
USE symme, ONLY: s, nsym
|
|
|
|
USE wvfct, ONLY: npw, npwx, nbnd, gamma_only, igk, wg
|
2006-02-10 23:02:48 +08:00
|
|
|
USE noncollin_module, ONLY: noncolin, npol
|
2006-11-27 20:47:25 +08:00
|
|
|
USE wavefunctions_module, ONLY: evc
|
2003-01-20 05:58:50 +08:00
|
|
|
implicit none
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP) :: sigmanlc (3, 3), sigmakin (3, 3)
|
|
|
|
real(DP), allocatable :: gk (:,:), kfac (:)
|
|
|
|
real(DP) :: twobysqrtpi, gk2, arg
|
2007-01-23 00:38:47 +08:00
|
|
|
integer :: ik, l, m, i, ibnd, is
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
allocate (gk( 3, npwx))
|
|
|
|
allocate (kfac( npwx))
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
sigmanlc(:,:) =0.d0
|
|
|
|
sigmakin(:,:) =0.d0
|
2003-02-08 00:04:36 +08:00
|
|
|
twobysqrtpi = 2.d0 / sqrt (pi)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
kfac(:) = 1.d0
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
if (nks.gt.1) rewind (iunigk)
|
2007-01-23 00:38:47 +08:00
|
|
|
do ik = 1, nks
|
|
|
|
npw = ngk(ik)
|
|
|
|
if (nks > 1) then
|
|
|
|
read (iunigk) igk
|
2007-02-21 21:01:31 +08:00
|
|
|
call get_buffer (evc, nwordwfc, iunwfc, ik)
|
2003-01-20 05:58:50 +08:00
|
|
|
endif
|
2003-02-08 00:04:36 +08:00
|
|
|
do i = 1, npw
|
2007-01-23 00:38:47 +08:00
|
|
|
gk (1, i) = (xk (1, ik) + g (1, igk (i) ) ) * tpiba
|
|
|
|
gk (2, i) = (xk (2, ik) + g (2, igk (i) ) ) * tpiba
|
|
|
|
gk (3, i) = (xk (3, ik) + g (3, igk (i) ) ) * tpiba
|
2003-02-08 00:04:36 +08:00
|
|
|
if (qcutz.gt.0.d0) then
|
|
|
|
gk2 = gk (1, i) **2 + gk (2, i) **2 + gk (3, i) **2
|
|
|
|
arg = ( (gk2 - ecfixed) / q2sigma) **2
|
|
|
|
kfac (i) = 1.d0 + qcutz / q2sigma * twobysqrtpi * exp ( - arg)
|
2003-01-20 05:58:50 +08:00
|
|
|
endif
|
|
|
|
enddo
|
|
|
|
!
|
|
|
|
! kinetic contribution
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
do l = 1, 3
|
|
|
|
do m = 1, l
|
|
|
|
do ibnd = 1, nbnd
|
|
|
|
do i = 1, npw
|
2006-02-10 23:02:48 +08:00
|
|
|
if (noncolin) then
|
2007-01-23 00:38:47 +08:00
|
|
|
sigmakin (l, m) = sigmakin (l, m) + wg (ibnd, ik) * &
|
2006-11-27 20:47:25 +08:00
|
|
|
gk (l, i) * gk (m, i) * kfac (i) * &
|
|
|
|
( DBLE (CONJG(evc(i ,ibnd))*evc(i ,ibnd)) + &
|
|
|
|
DBLE (CONJG(evc(i+npwx,ibnd))*evc(i+npwx,ibnd)))
|
2006-02-10 23:02:48 +08:00
|
|
|
else
|
2007-01-23 00:38:47 +08:00
|
|
|
sigmakin (l, m) = sigmakin (l, m) + wg (ibnd, ik) * &
|
2006-02-10 23:02:48 +08:00
|
|
|
gk (l, i) * gk (m, i) * kfac (i) * &
|
|
|
|
DBLE (CONJG(evc (i, ibnd) ) * evc (i, ibnd) )
|
|
|
|
end if
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
|
|
|
|
enddo
|
|
|
|
!
|
|
|
|
! contribution from the nonlocal part
|
|
|
|
!
|
2007-01-23 00:38:47 +08:00
|
|
|
call stres_us (ik, gk, sigmanlc)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
enddo
|
|
|
|
!
|
2005-09-22 22:03:29 +08:00
|
|
|
! add the US term from augmentation charge derivatives
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
call addusstres (sigmanlc)
|
2003-02-21 22:57:00 +08:00
|
|
|
#ifdef __PARA
|
2003-02-08 00:04:36 +08:00
|
|
|
call reduce (9, sigmakin)
|
|
|
|
call poolreduce (9, sigmakin)
|
|
|
|
call reduce (9, sigmanlc)
|
|
|
|
call poolreduce (9, sigmanlc)
|
2003-01-20 05:58:50 +08:00
|
|
|
#endif
|
|
|
|
!
|
|
|
|
! symmetrize stress
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
do l = 1, 3
|
|
|
|
do m = 1, l - 1
|
|
|
|
sigmanlc (m, l) = sigmanlc (l, m)
|
|
|
|
sigmakin (m, l) = sigmakin (l, m)
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
!
|
|
|
|
if (gamma_only) then
|
|
|
|
sigmakin(:,:) = 2.d0 * e2 / omega * sigmakin(:,:)
|
|
|
|
else
|
|
|
|
sigmakin(:,:) = e2 / omega * sigmakin(:,:)
|
|
|
|
end if
|
2003-02-08 00:04:36 +08:00
|
|
|
call trntns (sigmakin, at, bg, - 1)
|
|
|
|
call symtns (sigmakin, nsym, s)
|
|
|
|
call trntns (sigmakin, at, bg, 1)
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
sigmanlc(:,:) = -1.d0 / omega * sigmanlc(:,:)
|
2003-02-08 00:04:36 +08:00
|
|
|
call trntns (sigmanlc, at, bg, - 1)
|
|
|
|
call symtns (sigmanlc, nsym, s)
|
|
|
|
call trntns (sigmanlc, at, bg, 1)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
deallocate(kfac)
|
|
|
|
deallocate(gk)
|
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
end subroutine stres_knl
|
|
|
|
|