1
2! Copyright (C) 2002-2005 J. K. Dewhurst, S. Sharma and C. Ambrosch-Draxl.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6!BOP
7! !ROUTINE: rhonorm
8! !INTERFACE:
9subroutine rhonorm
10! !USES:
11use modmain
12! !DESCRIPTION:
13!   Loss of precision of the calculated total charge can result because the
14!   muffin-tin density is computed on a set of $(\theta,\phi)$ points and then
15!   transformed to a spherical harmonic representation. This routine adds a
16!   constant to the density so that the total charge is correct. If the error in
17!   total charge exceeds a certain tolerance then a warning is issued.
18!
19! !REVISION HISTORY:
20!   Created April 2003 (JKD)
21!   Changed from rescaling to adding, September 2006 (JKD)
22!EOP
23!BOC
24implicit none
25! local variables
26integer is,ia,ias
27integer nr,nri,ir,i
28real(8) t1,t2
29if (.not.trhonorm) return
30! check error in total charge
31t1=chgcalc/chgtot-1.d0
32if (abs(t1).gt.epschg) then
33  write(*,*)
34  write(*,'("Warning(rhonorm): total charge density incorrect for s.c. &
35   &loop ",I5)') iscl
36  write(*,'(" Calculated : ",G18.10)') chgcalc
37  write(*,'(" Required   : ",G18.10)') chgtot
38end if
39! error in average density
40t1=(chgtot-chgcalc)/omega
41! add the constant difference to the density
42t2=t1/y00
43do ias=1,natmtot
44  is=idxis(ias)
45  nr=nrmt(is)
46  nri=nrmti(is)
47  i=1
48  do ir=1,nri
49    rhomt(i,ias)=rhomt(i,ias)+t2
50    i=i+lmmaxi
51  end do
52  do ir=nri+1,nr
53    rhomt(i,ias)=rhomt(i,ias)+t2
54    i=i+lmmaxo
55  end do
56end do
57rhoir(1:ngtot)=rhoir(1:ngtot)+t1
58! add the difference to the charges
59t1=t1*(fourpi/3.d0)
60do is=1,nspecies
61  t2=t1*rmt(is)**3
62  do ia=1,natoms(is)
63    ias=idxas(ia,is)
64    chgmt(ias)=chgmt(ias)+t2
65    chgmttot=chgmttot+t2
66  end do
67end do
68chgir=chgtot-chgmttot
69end subroutine
70!EOC
71
72