File: doccupy.f90

package info (click to toggle)
elkcode 5.4.24-2
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 12,840 kB
  • sloc: f90: 48,415; fortran: 22,457; perl: 965; makefile: 384; sh: 369; python: 105; ansic: 67
file content (53 lines) | stat: -rw-r--r-- 1,137 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

! Copyright (C) 2015 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

subroutine doccupy
use modmain
use modphonon
implicit none
! local variables
integer, parameter :: maxit=1000
integer ik,jk,ist,it
real(8) de0,de1,de
real(8) dchg,x,dx,t1
! external functions
real(8) sdelta
external sdelta
if (.not.tphq0) return
de0=1.d6
de1=-1.d6
do ik=1,nkptnr
  do ist=1,nstsv
    de=devalsv(ist,ik)
    if (de.lt.de0) de0=de
    if (de.gt.de1) de1=de
  end do
end do
t1=1.d0/swidth
do it=1,maxit
  defermi=0.5d0*(de0+de1)
  dchg=0.d0
  do ik=1,nkptnr
    jk=ivkik(ivk(1,ik),ivk(2,ik),ivk(3,ik))
    do ist=1,nstsv
      x=(efermi-evalsv(ist,jk))*t1
      dx=(defermi-devalsv(ist,ik))*t1
      doccsv(ist,ik)=occmax*sdelta(stype,x)*dx
      dchg=dchg+wkptnr*doccsv(ist,ik)
    end do
  end do
  if (dchg.lt.0.d0) then
    de0=defermi
  else
    de1=defermi
  end if
  if ((de1-de0).lt.1.d-12) goto 10
end do
write(*,*)
write(*,'("Warning(doccupy): could not find Fermi energy derivative")')
10 continue
return
end subroutine