2003-01-20 05:58:50 +08:00
|
|
|
!
|
2011-03-07 18:54:10 +08:00
|
|
|
! Copyright (C) 2001-2011 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 .
|
|
|
|
!
|
|
|
|
!--------------------------------------------------------------------
|
2011-03-07 18:54:10 +08:00
|
|
|
FUNCTION sumkt (et, nbnd, nks, nspin, ntetra, tetra, e, is, isk)
|
2003-01-20 05:58:50 +08:00
|
|
|
!--------------------------------------------------------------------
|
|
|
|
!
|
2011-03-07 18:54:10 +08:00
|
|
|
! ... Sum over all states with tetrahedron method
|
|
|
|
! ... At Fermi energy e=E_F, sumkt(e) == number of electrons
|
|
|
|
! ... Generalization to noncollinear case courtesy of Yurii Timrov
|
|
|
|
!
|
2004-01-23 23:08:03 +08:00
|
|
|
USE kinds
|
2003-02-08 00:04:36 +08:00
|
|
|
implicit none
|
2005-03-17 22:47:46 +08:00
|
|
|
! output variable
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP) :: sumkt
|
2005-03-17 22:47:46 +08:00
|
|
|
! input variable
|
|
|
|
integer, intent(in) :: nbnd, nks, nspin, ntetra, tetra (4, ntetra)
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP), intent(in) :: et (nbnd, nks), e
|
2005-03-17 22:47:46 +08:00
|
|
|
integer, intent(in) :: is, isk
|
|
|
|
! local variables
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP) :: etetra (4), e1, e2, e3, e4
|
2011-03-04 16:22:09 +08:00
|
|
|
integer :: nt, nk, ns, ibnd, i, nspin_lsda
|
2005-05-25 01:17:27 +08:00
|
|
|
|
2011-03-04 16:22:09 +08:00
|
|
|
IF ( nspin == 2 ) THEN
|
|
|
|
nspin_lsda = 2
|
|
|
|
ELSE
|
|
|
|
nspin_lsda = 1
|
|
|
|
END IF
|
2006-12-14 16:53:47 +08:00
|
|
|
sumkt = 0.0d0
|
2011-03-04 16:22:09 +08:00
|
|
|
do ns = 1, nspin_lsda
|
2005-03-17 22:47:46 +08:00
|
|
|
if (is /= 0) then
|
|
|
|
if ( ns .ne. is) cycle
|
|
|
|
end if
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
! nk is used to select k-points with up (ns=1) or down (ns=2) spin
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
if (ns.eq.1) then
|
|
|
|
nk = 0
|
|
|
|
else
|
|
|
|
nk = nks / 2
|
2003-01-20 05:58:50 +08:00
|
|
|
endif
|
2003-02-08 00:04:36 +08:00
|
|
|
do nt = 1, ntetra
|
|
|
|
do ibnd = 1, nbnd
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
! etetra are the energies at the vertexes of the nt-th tetrahedron
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
do i = 1, 4
|
|
|
|
etetra (i) = et (ibnd, tetra (i, nt) + nk)
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
call piksort (4, etetra)
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
! ...sort in ascending order: e1 < e2 < e3 < e4
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
e1 = etetra (1)
|
|
|
|
e2 = etetra (2)
|
|
|
|
e3 = etetra (3)
|
|
|
|
e4 = etetra (4)
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
! calculate sum over k of the integrated charge
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
if (e.ge.e4) then
|
|
|
|
sumkt = sumkt + 1.d0 / ntetra
|
|
|
|
elseif (e.lt.e4.and.e.ge.e3) then
|
2006-12-14 16:53:47 +08:00
|
|
|
sumkt = sumkt + 1.d0 / ntetra * (1.0d0 - (e4 - e) **3 / (e4 - e1) &
|
2003-01-20 05:58:50 +08:00
|
|
|
/ (e4 - e2) / (e4 - e3) )
|
2003-02-08 00:04:36 +08:00
|
|
|
elseif (e.lt.e3.and.e.ge.e2) then
|
2003-01-20 05:58:50 +08:00
|
|
|
sumkt = sumkt + 1.d0 / ntetra / (e3 - e1) / (e4 - e1) * &
|
2006-12-14 16:53:47 +08:00
|
|
|
( (e2 - e1) **2 + 3.0d0 * (e2 - e1) * (e-e2) + 3.0d0 * (e-e2) **2 - &
|
2003-01-20 05:58:50 +08:00
|
|
|
(e3 - e1 + e4 - e2) / (e3 - e2) / (e4 - e2) * (e-e2) **3)
|
2003-02-08 00:04:36 +08:00
|
|
|
elseif (e.lt.e2.and.e.ge.e1) then
|
2003-01-20 05:58:50 +08:00
|
|
|
sumkt = sumkt + 1.d0 / ntetra * (e-e1) **3 / (e2 - e1) / &
|
|
|
|
(e3 - e1) / (e4 - e1)
|
|
|
|
endif
|
|
|
|
enddo
|
|
|
|
enddo
|
|
|
|
enddo
|
2011-03-07 18:54:10 +08:00
|
|
|
|
|
|
|
! add correct spin normalization (2 for LDA, 1 for other cases)
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2011-03-04 16:22:09 +08:00
|
|
|
IF ( nspin == 1 ) sumkt = sumkt * 2.d0
|
2011-03-07 18:54:10 +08:00
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
|
|
|
|
end function sumkt
|
|
|
|
|
2003-02-08 00:04:36 +08:00
|
|
|
subroutine piksort (n, a)
|
2004-01-23 23:08:03 +08:00
|
|
|
USE kinds
|
2003-02-08 00:04:36 +08:00
|
|
|
implicit none
|
|
|
|
integer :: n
|
2003-01-20 05:58:50 +08:00
|
|
|
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP) :: a (n)
|
2003-02-08 00:04:36 +08:00
|
|
|
integer :: i, j
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP) :: temp
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
do j = 2, n
|
|
|
|
temp = a (j)
|
|
|
|
do i = j - 1, 1, - 1
|
|
|
|
if (a (i) .le.temp) goto 10
|
|
|
|
a (i + 1) = a (i)
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
i = 0
|
|
|
|
10 a (i + 1) = temp
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
end subroutine piksort
|