scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More cleanup and maaybe small bugs fixed

This commit is contained in:
Paolo Giannozzi 2019-01-25 17:42:46 +01:00
parent 6451573ba8
commit d2b1759025
3 changed files with 24 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Modules/xc_vdW_DF.f90
View File

@ -550,10 +550,10 @@ CONTAINS
grid_cell_volume = omega/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
do i_grid = 1, dfftp%nnr
vtxc = vtxc + e2 * grid_cell_volume * (rho_valence(i_grid,1) + rho_valence(i_grid,2)) &
* potential_up (i_grid) &
+ e2 * grid_cell_volume * (rho_valence(i_grid,1) - rho_valence(i_grid,2)) &
* potential_down(i_grid)
vtxc = vtxc + e2 * grid_cell_volume * (rho_valence(i_grid,1) + &
rho_valence(i_grid,2)) * 0.5_dp * potential_up (i_grid) &
+ e2 * grid_cell_volume * (rho_valence(i_grid,1) - &
rho_valence(i_grid,2)) * 0.5_dp * potential_down(i_grid)
end do
deallocate( potential_up, potential_down, q0, grad_rho, grad_rho_up, &

26
PP/src/paw_postproc.f90
View File

@ -36,7 +36,7 @@ SUBROUTINE PAW_make_ae_charge(rho,withcore)
INTEGER :: ia
REAL(DP),ALLOCATABLE :: wsp_lm(:,:,:), ylm_posi(:,:), d1y(:), d2y(:)
REAL(DP),ALLOCATABLE :: rho_lm(:,:,:), rho_lm_ae(:,:,:), rho_lm_ps(:,:,:)
REAL(DP) :: posi(3), first, second
REAL(DP) :: posi(3), first, second, rhoup, rhodw
REAL(DP) :: inv_nr1, inv_nr2, inv_nr3, distsq
! Some initialization
@ -151,22 +151,26 @@ SUBROUTINE PAW_make_ae_charge(rho,withcore)
IF ( nspin/=2 ) THEN
DO is = 1,nspin
DO lm = 1, i%l**2
! do interpolation
! do interpolation - distsq depends upon ir
rho%of_r(ir,is)= rho%of_r(ir,is) + ylm_posi(1,lm) &
* splint(g(i%t)%r(:) , rho_lm(:,lm,is), &
wsp_lm(:,lm,is), sqrt(distsq) )
ENDDO
ENDDO
ELSE
DO lm = 1, i%l**2
! do interpolation
rho%of_r(ir,1)= rho%of_r(ir,is) + ylm_posi(1,lm) &
* splint(g(i%t)%r(:) , rho_lm(:,lm,is), &
wsp_lm(:,lm,is), sqrt(distsq) )
rho%of_r(ir,2)= rho%of_r(ir,is) + ylm_posi(1,lm)*(2*mod(is,2)-1) &
* splint(g(i%t)%r(:) , rho_lm(:,lm,is), &
wsp_lm(:,lm,is), sqrt(distsq) )
ENDDO
DO lm = 1, i%l**2
! do interpolation
is = 1
rhoup = splint(g(i%t)%r(:) , rho_lm(:,lm,is), &
wsp_lm(:,lm,is), sqrt(distsq) )
is = 2
rhodw = splint(g(i%t)%r(:) , rho_lm(:,lm,is), &
wsp_lm(:,lm,is), sqrt(distsq) )
rho%of_r(ir,1)= rho%of_r(ir,1) + ylm_posi(1,lm) * &
(rhoup + rhodw)
rho%of_r(ir,2)= rho%of_r(ir,2) + ylm_posi(1,lm) * &
(rhoup - rhodw)
ENDDO
ENDIF
ENDDO rsp_point
!

12
PP/src/ppacf.f90
View File

@ -252,10 +252,7 @@ PROGRAM do_ppacf
CALL mp_sum( etxcccnl , intra_bgrp_comm )
END IF
!
! ... add gradiend corrections (if any)
!
if (nspin==4) CALL errore ('ppacf', 'Noncollinear not implemented', 1)
fac = 1.D0 / DBLE( nspin )
! ... add gradient corrections (if any)
!
ALLOCATE( grho( 3, dfftp%nnr, nspin) )
ALLOCATE( rhoout( dfftp%nnr, nspin) )
@ -263,12 +260,13 @@ PROGRAM do_ppacf
ALLOCATE( rhogsum( ngm, nspin ) )
!
! ... calculate the gradient of rho + rho_core in real space
! ... note: input rho is (tot,magn), output rhoout, grho are (up,down)
!
!
fac = 1.D0 / DBLE( nspin )
!
DO is = 1, nspin
!
indx = DBLE( nspin/2 * (1-2*(is/2)) )
indx = DBLE( nspin/2 * (1-2*(is/2)) ) ! +1 if is=1, -1 if is=2
rhoout(:,is) = fac * ( rho_core(:) + rho%of_r(:,1) + indx * rho%of_r(:,2) )
rhogsum(:,is) = fac * ( rhog_core(:) + rho%of_g(:,1) + indx * rho%of_g(:,2) )
!
@ -280,7 +278,7 @@ PROGRAM do_ppacf
!
IF (nspin == 1) THEN
tot_rho(:)=rhoout(:,1)
ELSEIF(nspin==2) THEN ! rhoout is (up,down)
ELSEIF(nspin==2) THEN
tot_rho(:)=rhoout(:,1)+rhoout(:,2)
ELSE
CALL errore ('ppacf','vdW-DF not available for noncollinear spin case',1)