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