2003-01-20 05:58:50 +08:00
|
|
|
!
|
2003-04-07 20:55:29 +08:00
|
|
|
! Copyright (C) 2001-2003 PWSCF 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-04-07 20:55:29 +08:00
|
|
|
subroutine efermig (et, nbnd, nks, nelec, wk, Degauss, Ngauss, Ef)
|
2003-01-20 05:58:50 +08:00
|
|
|
!--------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
! Finds the Fermi energy - Gaussian Broadening (Methfessel-Paxton)
|
|
|
|
!
|
2003-11-04 18:53:05 +08:00
|
|
|
USE io_global, ONLY : stdout
|
2003-01-20 05:58:50 +08:00
|
|
|
use parameters
|
2003-02-08 00:04:36 +08:00
|
|
|
implicit none
|
2003-04-07 20:55:29 +08:00
|
|
|
integer :: nks, nbnd, i, kpoint, Ngauss
|
|
|
|
real(kind=DP) :: wk (nks), et (nbnd, nks), Degauss, Ef, Eup, Elw, &
|
|
|
|
sumkup, sumklw, sumkmid, nelec
|
|
|
|
real(kind=DP), external:: sumkg
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
! find bounds for the Fermi energy. Very safe choice!
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
Elw = et (1, 1)
|
|
|
|
Eup = et (nbnd, 1)
|
|
|
|
do kpoint = 2, nks
|
|
|
|
Elw = min (Elw, et (1, kpoint) )
|
|
|
|
Eup = max (Eup, et (nbnd, kpoint) )
|
2003-01-20 05:58:50 +08:00
|
|
|
enddo
|
2003-02-08 00:04:36 +08:00
|
|
|
Eup = Eup + 2 * Degauss
|
|
|
|
Elw = Elw - 2 * Degauss
|
2003-02-21 22:57:00 +08:00
|
|
|
#ifdef __PARA
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
! find min and max across pools
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
call poolextreme (Eup, + 1)
|
|
|
|
call poolextreme (Elw, - 1)
|
2003-01-20 05:58:50 +08:00
|
|
|
#endif
|
|
|
|
!
|
|
|
|
! Bisection method
|
|
|
|
!
|
2003-04-07 20:55:29 +08:00
|
|
|
sumkup = sumkg (et, nbnd, nks, wk, Degauss, Ngauss, Eup)
|
|
|
|
sumklw = sumkg (et, nbnd, nks, wk, Degauss, Ngauss, Elw)
|
2003-01-20 05:58:50 +08:00
|
|
|
if ( (sumkup - nelec) .lt. - 1.0e-10.or. (sumklw - nelec) &
|
2003-02-21 22:57:00 +08:00
|
|
|
.gt.1.0e-10) call errore ('Efermi', 'unexpected error', 1)
|
2003-02-08 00:04:36 +08:00
|
|
|
do i = 1, 50
|
|
|
|
Ef = (Eup + Elw) / 2.0
|
2003-04-07 20:55:29 +08:00
|
|
|
sumkmid = sumkg (et, nbnd, nks, wk, Degauss, Ngauss, Ef)
|
2003-02-08 00:04:36 +08:00
|
|
|
if (abs (sumkmid-nelec) .lt.1.0e-10) then
|
|
|
|
return
|
|
|
|
elseif ( (sumkmid-nelec) .lt. - 1.0e-10) then
|
|
|
|
Elw = Ef
|
|
|
|
else
|
|
|
|
Eup = Ef
|
2003-01-20 05:58:50 +08:00
|
|
|
endif
|
|
|
|
enddo
|
2003-11-04 18:53:05 +08:00
|
|
|
WRITE( stdout, '(5x,"Warning: too many iterations in bisection"/ &
|
2003-01-20 05:58:50 +08:00
|
|
|
& 5x,"Ef = ",f10.6," sumk = ",f10.6," electrons")' ) &
|
|
|
|
Ef * 13.6058, sumkmid
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
return
|
2003-01-20 05:58:50 +08:00
|
|
|
end subroutine efermig
|
|
|
|
|