1! 2! Copyright (C) 2007 Quantum ESPRESSO group 3! This file is distributed under the terms of the 4! GNU General Public License. See the file `License' 5! in the root directory of the present distribution, 6! or http://www.gnu.org/copyleft/gpl.txt . 7! 8! 9!----------------------------------------------------------------------- 10subroutine set_rc_rv() 11 !----------------------------------------------------------------------- 12 ! 13 ! input : all-electron wavefunctions + valence states 14 ! output: separated core and valence charges 15 ! 16 use kinds, only : dp 17 use ld1_parameters, only : nwfx 18 19 use ld1inc, only : grid, aeccharge, aevcharge, nwf, oc, isw, rel, psi, & 20 core_state 21 implicit none 22 23 integer :: n, ns, is 24 ! 25 ! calculates core charge density 26 ! 27 aevcharge=0.0_DP 28 aeccharge=0.0_DP 29 do n=1,grid%mesh 30 do ns=1,nwf 31 if (oc(ns)>0.0_DP) then 32 is=isw(ns) 33 if (rel==2) then 34 if (core_state(ns)) then 35 aeccharge(n)=aeccharge(n) & 36 +oc(ns)*( psi(n,1,ns)**2 + psi(n,2,ns)**2 ) 37 else 38 aevcharge(n,is)=aevcharge(n,is)+oc(ns)*(psi(n,1,ns)**2 & 39 + psi(n,2,ns)**2) 40 endif 41 else 42 if (core_state(ns)) then 43 aeccharge(n) = aeccharge(n) + oc(ns)*psi(n,1,ns)**2 44 else 45 aevcharge(n,is) = aevcharge(n,is) + oc(ns)*psi(n,1,ns)**2 46 endif 47 endif 48 endif 49 enddo 50 enddo 51 return 52end subroutine set_rc_rv 53