Small error slipped in previous commit.

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@4423 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
paulatto 2007-11-12 15:33:12 +00:00
parent dce5f820da
commit 3ee15febfe
2 changed files with 1 additions and 182 deletions

View File

@ -508,20 +508,6 @@ gradcorr.o : ../Modules/kind.o
gradcorr.o : ../Modules/wavefunctions.o
gradcorr.o : noncol.o
gradcorr.o : pwcom.o
grid_paw_routines.o : ../Modules/atom.o
grid_paw_routines.o : ../Modules/cell_base.o
grid_paw_routines.o : ../Modules/constants.o
grid_paw_routines.o : ../Modules/grid_paw_variables.o
grid_paw_routines.o : ../Modules/io_global.o
grid_paw_routines.o : ../Modules/ions_base.o
grid_paw_routines.o : ../Modules/kind.o
grid_paw_routines.o : ../Modules/parameters.o
grid_paw_routines.o : ../Modules/uspp.o
grid_paw_routines.o : ../Modules/wavefunctions.o
grid_paw_routines.o : noncol.o
grid_paw_routines.o : pwcom.o
grid_paw_routines.o : rad_paw_routines.o
grid_paw_routines.o : scf_mod.o
gweights.o : ../Modules/kind.o
h_1psi.o : ../Modules/kind.o
h_1psi.o : noncol.o
@ -600,6 +586,7 @@ init_us_1.o : ../Modules/parameters.o
init_us_1.o : ../Modules/paw_variables.o
init_us_1.o : ../Modules/splinelib.o
init_us_1.o : ../Modules/uspp.o
init_us_1.o : paw_init.o
init_us_1.o : pwcom.o
init_us_2.o : ../Modules/cell_base.o
init_us_2.o : ../Modules/constants.o
@ -687,7 +674,6 @@ mix_pot.o : ../Modules/mp_global.o
mix_rho.o : ../Modules/cell_base.o
mix_rho.o : ../Modules/constants.o
mix_rho.o : ../Modules/control_flags.o
mix_rho.o : ../Modules/grid_paw_variables.o
mix_rho.o : ../Modules/io_files.o
mix_rho.o : ../Modules/io_global.o
mix_rho.o : ../Modules/ions_base.o
@ -888,17 +874,6 @@ pwscf.o : pwcom.o
qvan2.o : ../Modules/kind.o
qvan2.o : ../Modules/uspp.o
qvan2.o : pwcom.o
rad_paw_routines.o : ../Modules/atom.o
rad_paw_routines.o : ../Modules/constants.o
rad_paw_routines.o : ../Modules/control_flags.o
rad_paw_routines.o : ../Modules/functionals.o
rad_paw_routines.o : ../Modules/grid_paw_variables.o
rad_paw_routines.o : ../Modules/ions_base.o
rad_paw_routines.o : ../Modules/kind.o
rad_paw_routines.o : ../Modules/parameters.o
rad_paw_routines.o : ../Modules/radial_grids.o
rad_paw_routines.o : ../Modules/uspp.o
rad_paw_routines.o : pwcom.o
rcgdiagg.o : ../Modules/constants.o
rcgdiagg.o : ../Modules/kind.o
rcgdiagg.o : pwcom.o
@ -1424,7 +1399,6 @@ gen_us_dj.o : ../include/f_defs.h
gen_us_dy.o : ../include/f_defs.h
ggen.o : ../include/f_defs.h
gradcorr.o : ../include/f_defs.h
grid_paw_routines.o : ../include/f_defs.h
h_epsi_her_apply.o : ../include/f_defs.h
h_epsi_her_set.o : ../include/f_defs.h
h_psi_meta.o : ../include/f_defs.h

View File

@ -106,9 +106,6 @@ SUBROUTINE mix_rho( input_rhout, rhoin, input_becout, becin, &
!
! ... external functions
!
#ifdef __GRID_PAW
REAL(DP), EXTERNAL :: rho1_ddot
#endif
!
CALL start_clock( 'mix_rho' )
!
@ -426,158 +423,6 @@ SUBROUTINE mix_rho( input_rhout, rhoin, input_becout, becin, &
!
END SUBROUTINE mix_rho
!
#ifdef __GRID_PAW
!----------------------------------------------------------------------------
FUNCTION rho1_ddot( bec1, bec2 )
!----------------------------------------------------------------------------
!
! ... calculates 4pi/G^2*rho1(-G)*rho2(G) = V1_Hartree(-G)*rho2(G),
! ... where rho1 and rho2 are 1-center charges (AE and PS)
! ... input variables are the augmentation channel occupations
! ... used as an estimate of the self-consistency error on the energy
!
USE kinds, ONLY : DP
USE constants, ONLY : e2, tpi, fpi
USE cell_base, ONLY : omega, tpiba2
USE gvect, ONLY : ngm, nl, nlm, gg, g, gstart
USE lsda_mod, ONLY : nspin
USE wvfct, ONLY : gamma_only
!
USE grid_paw_variables, ONLY : pp, okpaw, prodp, prodpt, prod0p, prod0pt
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE uspp_param, ONLY : nh, nhm
USE wvfct, ONLY : gamma_only
!
IMPLICIT NONE
!
! ... I/O variables
!
REAL(DP), INTENT(IN) :: &
bec1(nhm*(nhm+1)/2,nat,nspin), &
bec2(nhm*(nhm+1)/2,nat,nspin)
!
REAL(DP) :: rho1_ddot
!
! ... and the local variables
!
REAL(DP) :: fac ! a multiplicative factor
!
INTEGER :: gi, ig, na, nt, ih, jh, ijh, ijh2, is
! counters
!
COMPLEX(DP), POINTER :: prodp_(:,:,:), prod0p_(:,:,:)
INTEGER :: i_what
REAL(DP):: i_sign
!
rho1_ddot = 0._dp
!
IF ( .NOT. okpaw ) RETURN
!
gi = gstart
!
fac = e2 * fpi / tpiba2
!
whattodo: DO i_what=1, 2
!
NULLIFY(prodp_,prod0p_)
IF (i_what==1) THEN
prodp_ => prodp
prod0p_ => prod0p
ELSE IF (i_what==2) THEN
prodp_ => prodpt
prod0p_ => prod0pt
END IF
i_sign = DBLE(1-2*(i_what-1)) ! = +1 if i_what==1, -1 if i_what==2
!
DO ijh = 1, nhm*(nhm+1)/2
!
DO ijh2 = 1, nhm*(nhm+1)/2
!
DO na = 1, nat
!
nt = ityp (na)
IF ( nspin == 1 ) THEN
!
rho1_ddot = rho1_ddot + i_sign * fac * &
bec1(ijh,na,1) * prodp_(ijh, ijh2, nt) * bec2(ijh2,na,1)
!
!!$ gamma_only case not yet implemented
!!$ IF ( gamma_only ) rho1_ddot = 2.D0 * rho1_ddot
!
ELSE IF ( nspin == 2 ) THEN
!
! ... first the charge
!
rho1_ddot = rho1_ddot + i_sign * fac * &
(bec1(ijh,na,1)+bec1(ijh,na,2)) * prodp_(ijh,ijh2,nt) * &
(bec2(ijh2,na,1)+bec2(ijh2,na,2))
!
!!$ IF ( gamma_only ) rho1_ddot = 2.D0 * rho1_ddot
!
! ... then the magnetization
!
fac = e2 * fpi / tpi**2 ! lambda = 1 a.u.
!
! ... G=0 term
!
IF ( gstart == 2 ) THEN
!
rho1_ddot = rho1_ddot + i_sign * fac * &
(bec1(ijh,na,1)-bec1(ijh,na,2)) * prod0p_(ijh,ijh2,nt) * &
(bec2(ijh2,na,1)-bec2(ijh2,na,2))
!
END IF
!
!!$ IF ( gamma_only ) fac = 2.D0 * fac
!
rho1_ddot = rho1_ddot + i_sign * fac * &
(bec1(ijh,na,1)-bec1(ijh,na,2)) * prodp_(ijh,ijh2,nt) * &
(bec2(ijh2,na,1)-bec2(ijh2,na,2))
!
!!$ non-collinear case not yet implemented
!!$ ELSE IF ( nspin == 4 ) THEN
!!$ !
!!$ rho1_ddot = rho1_ddot + fac * DBLE((-1)**(i_what-1)) *
!!$ bec1(ijh,na,1) * prodp_(ijh, ijh2, nt) * bec2(ijh2,na,1)
!!$ !
!!$ IF ( gamma_only ) rho1_ddot = 2.D0 * rho1_ddot
!!$ !
!!$ fac = e2*fpi / (tpi**2) ! lambda=1 a.u.
!!$ !
!!$ IF ( gstart == 2 ) THEN
!!$ !
!!$ rho1_ddot = rho1_ddot + DBLE((-1)**(i_what-1)) * fac * &
!!$ bec1(ijh,na,2) * prod0p_(ijh,ijh2,nt) * bec2(ijh2,na,2)+ &
!!$ bec1(ijh,na,3) * prod0p_(ijh,ijh2,nt) * bec2(ijh2,na,3)+ &
!!$ bec1(ijh,na,4) * prod0p_(ijh,ijh2,nt) * bec2(ijh2,na,4)
!!$ !
!!$ END IF
!!$ !
!!$ IF ( gamma_only ) fac = 2.D0 * fac
!!$ !
!!$ rho1_ddot = rho1_ddot + DBLE((-1)**(i_what-1)) * fac * &
!!$ ( bec1(ijh,na,2) * prodp_(ijh,ijh2,nt) * bec2(ijh2,na,2)+ &
!!$ bec1(ijh,na,3) * prodp_(ijh,ijh2,nt) * bec2(ijh2,na,3)+ &
!!$ bec1(ijh,na,4) * prodp_(ijh,ijh2,nt) * bec2(ijh2,na,4) )
!!$ !
END IF
!
END DO
!
END DO
!
END DO
!
END DO whattodo
!
rho1_ddot = rho1_ddot * omega * 0.5D0
!
CALL reduce( 1, rho1_ddot )
!
RETURN
!
END FUNCTION rho1_ddot
#endif
!----------------------------------------------------------------------------
SUBROUTINE approx_screening( drho )
!----------------------------------------------------------------------------