mirror of https://gitlab.com/QEF/q-e.git
98 lines
2.9 KiB
Fortran
98 lines
2.9 KiB
Fortran
!
|
|
! Copyright (C) 2001-2008 Quantum ESPRESSO 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 dvkb3(ik,dvkb)
|
|
!----------=========-------------------------------------------------------
|
|
!
|
|
!
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE cell_base, ONLY : at, tpiba
|
|
USE ions_base, ONLY : nat, ityp, ntyp => nsp
|
|
USE gvect, ONLY : g
|
|
USE lsda_mod, ONLY : lsda, current_spin, isk
|
|
USE klist, ONLY : xk, ngk, igk_k
|
|
USE wvfct, ONLY : npwx
|
|
USE wavefunctions, ONLY : evc
|
|
USE uspp, ONLY : nkb
|
|
USE uspp_param,ONLY : nh
|
|
USE uspp_init, ONLY : gen_us_dj, gen_us_dy
|
|
USE qpoint, ONLY : ikks
|
|
USE units_ph, ONLY : this_dvkb3_is_on_file, lrdvkb3, iudvkb3
|
|
implicit none
|
|
|
|
integer, intent(in) :: ik
|
|
complex(DP), intent(out) :: dvkb (npwx,nkb,3)
|
|
|
|
integer :: npw, jpol, nt, na, ikb, jkb, ig, ikk
|
|
|
|
real(DP), allocatable :: gk (:,:), g2kin(:)
|
|
|
|
complex(DP), allocatable :: work (:,:)
|
|
|
|
ikk=ikks(ik)
|
|
if (this_dvkb3_is_on_file(ik)) then
|
|
call davcio (dvkb, lrdvkb3, iudvkb3, ik, -1)
|
|
else
|
|
npw = ngk(ikk)
|
|
allocate (work(npwx,nkb))
|
|
allocate (gk(3, npw))
|
|
allocate (g2kin(npw))
|
|
!
|
|
do ig = 1, npw
|
|
gk (1, ig) = (xk (1, ikk) + g (1, igk_k (ig,ikk) ) ) * tpiba
|
|
gk (2, ig) = (xk (2, ikk) + g (2, igk_k (ig,ikk) ) ) * tpiba
|
|
gk (3, ig) = (xk (3, ikk) + g (3, igk_k (ig,ikk) ) ) * tpiba
|
|
g2kin (ig) = gk (1, ig) **2 + gk (2, ig) **2 + gk (3, ig) **2
|
|
if (g2kin (ig) .lt.1.0d-10) then
|
|
gk (1, ig) = 0.d0
|
|
gk (2, ig) = 0.d0
|
|
gk (3, ig) = 0.d0
|
|
else
|
|
gk (1, ig) = gk (1, ig) / sqrt (g2kin (ig) )
|
|
gk (2, ig) = gk (2, ig) / sqrt (g2kin (ig) )
|
|
gk (3, ig) = gk (3, ig) / sqrt (g2kin (ig) )
|
|
endif
|
|
enddo
|
|
|
|
if (lsda) current_spin = isk (ikk)
|
|
do jpol=1,3
|
|
call gen_us_dy (ikk, at (1, jpol), dvkb(1,1,jpol))
|
|
end do
|
|
call gen_us_dj (ikk, work)
|
|
|
|
jkb = 0
|
|
do nt = 1, ntyp
|
|
do na = 1, nat
|
|
if (nt.eq.ityp (na)) then
|
|
do ikb = 1, nh (nt)
|
|
jkb = jkb + 1
|
|
do jpol=1,3
|
|
do ig = 1, npw
|
|
dvkb(ig,jkb,jpol) = dvkb(ig,jkb,jpol) + work(ig, jkb) * &
|
|
(at (1, jpol) * gk (1, ig) + &
|
|
at (2, jpol) * gk (2, ig) + &
|
|
at (3, jpol) * gk (3, ig) )
|
|
enddo
|
|
enddo
|
|
enddo
|
|
endif
|
|
enddo
|
|
enddo
|
|
|
|
deallocate(g2kin)
|
|
deallocate(gk)
|
|
deallocate(work)
|
|
call davcio (dvkb, lrdvkb3, iudvkb3, ik, 1)
|
|
this_dvkb3_is_on_file(ik) = .true.
|
|
end if
|
|
|
|
return
|
|
|
|
end subroutine dvkb3
|