Commit ee8f47c8 authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' into MetaGGA

parents ae409a52 088e558e
MODULE m_cored
CONTAINS
SUBROUTINE cored(input, jspin, atoms, rho, DIMENSION, sphhar, vr, qint, rhc, tec, seig, EnergyDen)
SUBROUTINE cored(&
& input,jspin,atoms,&
& rho,DIMENSION,&
& sphhar,&
& vr,&
& qint,rhc,tec,seig)
! *******************************************************
! ***** set up the core densities for compounds. *****
! ***** d.d.koelling *****
......@@ -28,24 +34,21 @@ CONTAINS
REAL, INTENT(INOUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: qint(atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: tec(atoms%ntype,input%jspins)
REAL, INTENT(INOUT), OPTIONAL :: EnergyDen(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
! ..
! .. Local Scalars ..
REAL eig,fj,fl,fn,q,rad,rhos,rhs,sea,sume,t2
REAL d,dxx,rn,rnot,z,t1,rr,r,lambd,c,bmu,weight, aux_weight
REAL e,fj,fl,fn,q,rad,rhos,rhs,sea,sume,t2
REAL d,dxx,rn,rnot,z,t1,rr,r,lambd,c,bmu,weight
INTEGER i,j,jatom,korb,n,ncmsh,nm,nm1,nst ,l,ierr
! ..
! .. Local Arrays ..
REAL rhcs(DIMENSION%msh),rhoc(DIMENSION%msh),rhoss(DIMENSION%msh),vrd(DIMENSION%msh),f(0:3)
REAL rhcs_aux(DIMENSION%msh), rhoss_aux(DIMENSION%msh) !> quantities for energy density calculations
REAL occ(DIMENSION%nstd),a(DIMENSION%msh),b(DIMENSION%msh),ain(DIMENSION%msh),ahelp(DIMENSION%msh)
REAL occ_h(DIMENSION%nstd,2)
INTEGER kappa(DIMENSION%nstd),nprnc(DIMENSION%nstd)
CHARACTER(LEN=20) :: attributes(6)
REAL stateEnergies(29)
! ..
c = c_light(1.0)
seig = 0.
!
......@@ -96,7 +99,7 @@ CONTAINS
WRITE (6,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
WRITE (16,FMT=8000) z,rnot,dxx,atoms%jri(jatom)
DO j = 1,atoms%jri(jatom)
rhoss(j) = 0.0
rhoss(j) = 0.
vrd(j) = vr(j,jatom)
ENDDO
!
......@@ -134,35 +137,23 @@ CONTAINS
IF (occ(korb) /= 0.0) THEN
fn = nprnc(korb)
fj = iabs(kappa(korb)) - .5e0
weight = 2*fj + 1.e0
IF (bmu > 99.) weight = occ(korb)
fl = fj + (.5e0)*isign(1,kappa(korb))
eig = -2* (z/ (fn+fl))**2
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,ncmsh,vrd, eig, a,b,ierr)
stateEnergies(korb) = eig
WRITE (6,FMT=8010) fn,fl,fj,eig,weight
WRITE (16,FMT=8010) fn,fl,fj,eig,weight
e = -2* (z/ (fn+fl))**2
CALL differ(fn,fl,fj,c,z,dxx,rnot,rn,d,ncmsh,vrd, e, a,b,ierr)
stateEnergies(korb) = e
WRITE (6,FMT=8010) fn,fl,fj,e,weight
WRITE (16,FMT=8010) fn,fl,fj,e,weight
IF (ierr/=0) CALL juDFT_error("error in core-level routine" ,calledby ="cored")
IF (input%gw==1 .OR. input%gw==3) WRITE (15) NINT(fl),weight,eig,&
IF (input%gw==1 .OR. input%gw==3) WRITE (15) NINT(fl),weight,e,&
a(1:atoms%jri(jatom)),b(1:atoms%jri(jatom))
sume = sume + weight*eig/input%jspins
sume = sume + weight*e/input%jspins
DO j = 1,ncmsh
rhcs(j) = weight* (a(j)**2+b(j)**2)
rhoss(j) = rhoss(j) + rhcs(j)
ENDDO
IF(present(EnergyDen)) THEN
rhoss_aux = rhoss
DO j = 1,ncmsh
! for energy density we want to multiply the weights
! with the eigenenergies
rhoss_aux(j) = rhoss_aux(j) + (rhcs(j) * eig)
ENDDO
ENDIF
ENDIF
ENDDO
......@@ -174,14 +165,6 @@ CONTAINS
rho(j,0,jatom,jspin) = rho(j,0,jatom,jspin) + rhoc(j)/sfp_const
ENDDO
IF(present(EnergyDen)) then
DO j = 1,nm
rhoc(j) = rhoss(j)/input%jspins
EnergyDen(j,0,jatom,jspin) = EnergyDen(j,0,jatom,jspin) &
+ rhoss_aux(j) /(input%jspins * sfp_const)
ENDDO
ENDIF
rhc(1:ncmsh,jatom,jspin) = rhoss(1:ncmsh) / input%jspins
rhc(ncmsh+1:DIMENSION%msh,jatom,jspin) = 0.0
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment