Cleanup after latest merge

Doc/release-notes

@@ -31,6 +31,8 @@ Problems fixed in development version (+ = in qe-6.3-backports as well) :
   + bad format in upf%comment when writing the PP_INFO section of UPF v2 PPs
 
 Incompatible changes in development version:
+  * Charge density in the LSDA case is stored as (up+down, up-down) and no longer 
+    as (up,down). Output data format is unchanged to (up+down, up-down)
   * Non-symmorphic operations are always allowed and the FFT grid is made
     commensurate. Meaning and usage of input variable "use_all_frac" changed.
   * Old format (-D__OLDXML) deleted. Everything should work as before but some

PHonon/Gamma/a_h.f90

@@ -15,7 +15,7 @@ SUBROUTINE A_h(npw,e,h,ah)
   USE lsda_mod, ONLY : current_spin, nspin
   USE wvfct, ONLY: nbnd, npwx, g2kin
   USE wavefunctions,  ONLY: evc, psic
-  USE scf,      ONLY : vrs, rho, rhoz_or_updw
+  USE scf,      ONLY : vrs, rho
   USE fft_base, ONLY : dffts, dfftp
   USE fft_interfaces, ONLY : fwfft, invfft
   USE gvect,    ONLY : gstart, g, gg
@@ -121,15 +121,11 @@ SUBROUTINE A_h(npw,e,h,ah)
   !
   CALL start_clock('dgradcorr')
   IF (dft_is_gradient() ) THEN
-     !^
-     IF (nspin == 2) CALL rhoz_or_updw(rho, 'only_r', 'rhoz_updw')
      !
      CALL dgradcor1  &
          (dfftp, rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s,  &
           drho, dpsic, nspin, g, dv)
      !
-     IF (nspin == 2) CALL rhoz_or_updw(rho, 'only_r', 'updw_rhoz')
-     !^    
   ENDIF
   CALL stop_clock('dgradcorr')
   NULLIFY(dpsic)

PHonon/Gamma/cg_setup.f90

@@ -13,7 +13,7 @@ SUBROUTINE cg_setup
   USE kinds,      ONLY: DP
   USE cell_base,  ONLY: bg
   USE ions_base,  ONLY: nat, ntyp => nsp, ityp, tau, amass
-  USE scf,        ONLY: rho, rho_core, v, vltot, vrs, kedtau, rhoz_or_updw
+  USE scf,        ONLY: rho, rho_core, v, vltot, vrs, kedtau
   USE uspp,       ONLY: vkb, nlcc_any
   USE uspp_param, ONLY: upf
   USE mp_global,  ONLY: kunit
@@ -95,13 +95,9 @@ SUBROUTINE cg_setup
   ENDDO
   !
   !  initialize data needed for gradient corrections
-  !^
-  IF (nspin == 2) CALL rhoz_or_updw(rho, 'r_and_g', 'rhoz_updw')
   !
   CALL cg_setupdgc
   !
-  IF (nspin == 2) CALL rhoz_or_updw(rho, 'r_and_g', 'updw_rhoz')
-  !^
   iunres=88
   !
   !   open the wavefunction file (already existing)

PHonon/Gamma/cg_setupdgc.f90

@@ -13,7 +13,7 @@ SUBROUTINE cg_setupdgc
   !
   USE kinds, ONLY: dp
   USE constants, ONLY: e2
-  USE scf,   ONLY: rho, rho_core, rhog_core
+  USE scf,   ONLY: rho, rho_core, rhog_core, rhoz_or_updw
   USE funct, ONLY: gcxc, gcx_spin, gcc_spin, dgcxc, dgcxc_spin, dft_is_gradient
   USE fft_base, ONLY: dfftp
   USE gvect,    ONLY: ngm, g
@@ -24,7 +24,7 @@ SUBROUTINE cg_setupdgc
   IMPLICIT NONE
   INTEGER k, is
   real(DP) &
-       &       grho2(2), rh, zeta, grh2, epsr, epsg, fac,                 &
+       &       grho2(2), rh, zeta, grh2, epsr, epsg,                      &
        &       sx,sc,v1x,v2x,v1c,v2c,vrrx,vsrx,vssx,                      &
        &       vrrc,vsrc,vssc,                                            &
        &       v1xup,v1xdw,v2xup,v2xdw,                                   &
@@ -46,23 +46,18 @@ SUBROUTINE cg_setupdgc
   !
   !    add rho_core
   !
-  fac=1.d0/dble(nspin)
   IF (nlcc_any) THEN
-     DO is=1,nspin
-        rho%of_r(:,is)  = fac * rho_core(:)  + rho%of_r(:,is)
-        rho%of_g(:,is) = fac * rhog_core(:) + rho%of_g(:,is)
-     ENDDO
+     rho%of_r(:,1) = rho%of_r(:,1) + rho_core(:) 
+     rho%of_g(:,1) = rho%of_g(:,1) +rhog_core(:) 
   ENDIF
-  DO is=1,nspin
-     CALL fft_gradient_g2r (dfftp, rho%of_g(1,is), g, grho(1,1,is))
-  ENDDO
   !
   IF (nspin==1) THEN
+     CALL fft_gradient_g2r (dfftp, rho%of_g(1,1), g, grho(1,1,1))
      DO k = 1,dfftp%nnr
         grho2(1)=grho(1,k,1)**2+grho(2,k,1)**2+grho(3,k,1)**2
         IF (abs(rho%of_r(k,1))>epsr.and.grho2(1)>epsg) THEN
-           CALL gcxc(rho%of_r(k,nspin),grho2(1),sx,sc,v1x,v2x,v1c,v2c)
-           CALL dgcxc(rho%of_r(k,nspin),grho2(1),vrrx,vsrx,vssx,vrrc,vsrc,vssc)
+           CALL gcxc(rho%of_r(k,1),grho2(1),sx,sc,v1x,v2x,v1c,v2c)
+           CALL dgcxc(rho%of_r(k,1),grho2(1),vrrx,vsrx,vssx,vrrc,vsrc,vssc)
            dvxc_rr(k,1,1) = e2 * ( vrrx + vrrc )
            dvxc_sr(k,1,1) = e2 * ( vsrx + vsrc )
            dvxc_ss(k,1,1) = e2 * ( vssx + vssc )
@@ -70,9 +65,15 @@ SUBROUTINE cg_setupdgc
         ENDIF
      ENDDO
   ELSE
+     CALL rhoz_or_updw(rho, 'r_and_g', 'rhoz_updw')
+     !! bring (up+down,uo-down) charge to (up,down)
+     DO is=1,nspin
+        CALL fft_gradient_g2r (dfftp, rho%of_g(1,is), g, grho(1,1,is))
+     ENDDO
      DO k = 1,dfftp%nnr
-        grho2(2)=grho(1,k,2)**2+grho(2,k,2)**2+grho(3,k,2)**2
         rh=rho%of_r(k,1)+rho%of_r(k,2)
+        grho2(1)=grho(1,k,1)**2+grho(2,k,1)**2+grho(3,k,1)**2
+        grho2(2)=grho(1,k,2)**2+grho(2,k,2)**2+grho(3,k,2)**2
         grh2= (grho(1,k,1)+grho(1,k,2))**2                          &
                         + (grho(2,k,1)+grho(2,k,2))**2              &
                         + (grho(3,k,1)+grho(3,k,2))**2
@@ -118,12 +119,11 @@ SUBROUTINE cg_setupdgc
         dvxc_ss(k,2,1)=e2*vssc
         dvxc_ss(k,2,2)=e2*(vssxdw+vssc)
      ENDDO
+     CALL rhoz_or_updw(rho, 'r_and_g', 'updw_rhoz')
   ENDIF
   IF (nlcc_any) THEN
-     DO is=1,nspin
-        rho%of_r(:,is)  = rho%of_r(:,is)  - fac * rho_core(:)
-        rho%of_g(:,is) = rho%of_g(:,is) - fac * rhog_core(:)
-     ENDDO
+     rho%of_r(:,1) = rho%of_r(:,1) - rho_core(:) 
+     rho%of_g(:,1) = rho%of_g(:,1) -rhog_core(:) 
   ENDIF
   CALL stop_clock('setup_dgc')
   !

PHonon/Gamma/dgradcorr.f90

@@ -46,12 +46,12 @@ SUBROUTINE dgradcor1 (dfft, rho, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, &
      CALL fft_gradient_g2r (dfft, drhoc(1, is), g, gdrho (1,1,is) )
   ENDDO
   DO k = 1, dfft%nnr
-     grho2 = grho(1, k, 1)**2 + grho(2, k, 1)**2 + grho(3, k, 1)**2
      IF (nspin==1) THEN
         !
         !    LDA case
         !
-        IF (abs (rho (k, 1) ) >epsr.and.grho2>epsg) THEN
+        grho2 = grho(1, k, 1)**2 + grho(2, k, 1)**2 + grho(3, k, 1)**2
+        IF (abs (rho (k, 1) ) >epsr .and. grho2>epsg ) THEN
            s1 = grho (1, k, 1) * gdrho (1, k, 1) + &
                 grho (2, k, 1) * gdrho (2, k, 1) + &
                 grho (3, k, 1) * gdrho (3, k, 1)
@@ -116,8 +116,7 @@ SUBROUTINE dgradcor1 (dfft, rho, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, &
         ENDDO
         DO is = 1, nspin
            DO js = 1, nspin
-              dvxc (k, is) = dvxc (k, is) + dvxc_rr (k, is, js) * drho (k, &
-                   js)
+              dvxc (k, is) = dvxc (k, is) + dvxc_rr (k, is, js) * drho (k, js)
               DO ipol = 1, 3
                  h (ipol, k, is) = h (ipol, k, is) + &
                       dvxc_s (k, is, js) * gdrho(ipol, k, js)

PHonon/Gamma/phcg.f90

@@ -418,7 +418,7 @@ SUBROUTINE cg_neweps
   USE cell_base, ONLY : omega
   USE ions_base, ONLY : nat, tau
   USE fft_base,  ONLY : dfftp
-  USE scf,       ONLY : rho, rho_core, rhoz_or_updw
+  USE scf,       ONLY : rho, rho_core
   USE lsda_mod,  ONLY : nspin, current_spin
   USE funct,     ONLY : dmxc
   USE cgcom
@@ -443,13 +443,9 @@ SUBROUTINE cg_neweps
   ENDDO
   !
   !  re-initialize data needed for gradient corrections
-  !^
-  IF (nspin == 2) CALL rhoz_or_updw(rho, 'r_and_g', 'rhoz_updw')
   !
   CALL cg_setupdgc
   !
-  IF (nspin == 2) CALL rhoz_or_updw(rho, 'r_and_g', 'updw_rhoz')
-  !^
   !   calculate linear response to macroscopic fields
   !
   CALL macro

pseudo/clean_ps

@@ -18,7 +18,7 @@ tobesaved="HUSPBE.RRKJ3          \
 # Au.pz-rrkjus_aewfc.UPF : contains all-electron wavefunctions
 # Rh.pbe-rrkjus_lb.UPF, Rhs.pbe-rrkjus_lb.UPF : core-hole PPs
 # CorelUSPBE.RRKJ3.UPF: fully relativistic
-# C_3.98148.UPF : slightly ionized, for C-B systems
+# C_3.98148.UPF : B-C VCA pseudopotential, for slightly B-doped C systems
 # pb_s.UPF  Si_r.upf : fully relativistic
 
 mkdir .save