Commit d09ac29f authored by ccavazzoni's avatar ccavazzoni

- further rho related clean-up


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13761 c92efa57-630b-4861-b058-cf58834340f0
parent 2d32977b
......@@ -100,7 +100,7 @@
USE kinds, ONLY: DP
USE control_flags, ONLY: iprint, iverbosity, thdyn, tpre, trhor, ndr
USE ions_base, ONLY: nat
USE gvect, ONLY: ngm, nl, nlm, gstart, ig_l2g
USE gvect, ONLY: ngm, gstart, ig_l2g
USE gvecs, ONLY: ngms, nls, nlsm
USE smallbox_gvec, ONLY: ngb
USE gvecw, ONLY: ngw
......
......@@ -10,9 +10,8 @@
! ----------------------------------------------
!-----------------------------------------------------------------------
SUBROUTINE c2psi( psi, nnr, c, ca, ng, iflg )
!-----------------------------------------------------------------------
!
use gvecs, only: nlsm, nls
use kinds, only: DP
......@@ -70,179 +69,6 @@
return
END SUBROUTINE c2psi
!
!
!
SUBROUTINE rho2psi( grid_type, psi, nnr, rho, ng )
!
use gvect, only: nlm, nl
use gvecs, only: nlsm, nls
use kinds, only: DP
implicit none
complex(DP) :: psi(*), rho(*)
integer, intent(in) :: nnr, ng
character(len=*), intent(in) :: grid_type
integer :: ig
psi( 1 : nnr ) = 0.0d0
SELECT CASE ( grid_type )
!
! Case 0, 1 and 2 SMOOTH MESH
!
CASE ( 'Smooth' )
!
! without gamma sym
! do ig = 1, ng
! psi( nls( ig ) ) = rho( ig )
! end do
!
do ig = 1, ng
psi( nlsm( ig ) ) = CONJG( rho( ig ) )
psi( nls( ig ) ) = rho( ig )
end do
!
CASE ( 'Dense' )
!
! do ig = 1, ng
! psi( np( ig ) ) = rho( ig )
! end do
!
do ig = 1, ng
psi( nlm( ig ) ) = CONJG( rho( ig ) )
psi( nl( ig ) ) = rho( ig )
end do
!
CASE DEFAULT
!
CALL errore(" rho2psi "," wrong grid "//grid_type , 1 )
END SELECT
return
END SUBROUTINE rho2psi
!-----------------------------------------------------------------------
SUBROUTINE psi2c( psi, nnr, c, ca, ng, iflg )
use gvect, only: nlm, nl
use gvecs, only: nlsm, nls
use kinds, only: DP
implicit none
complex(DP) :: psi(*), c(*), ca(*)
integer, intent(in) :: nnr, ng, iflg
complex(DP), parameter :: ci=(0.0d0,1.0d0)
integer :: ig
!
! iflg "cases"
!
! 0, 10 Do not use gamma symmetry
!
! 1, 11 set psi using a wf with Gamma symmetry
!
! 2, 12 set psi combining two wf with Gamma symmetry
!
SELECT CASE ( iflg )
!
! Case 0, 1 and 2 SMOOTH MESH
!
CASE ( 0 )
!
do ig = 1, ng
c( ig ) = psi( nls( ig ) )
end do
!
CASE ( 1 )
!
CALL errore(" psi2c "," wrong value for iflg ", 11 )
!
CASE ( 2 )
!
DO ig = 1, ng
ca(ig) = psi( nlsm( ig ) )
c (ig) = psi( nls( ig ) )
END DO
!
! Case 10, 11 and 12 DENSE MESH
!
CASE ( 10 )
!
do ig = 1, ng
c( ig ) = psi( nl( ig ) )
end do
!
CASE ( 11 )
!
CALL errore(" psi2c "," wrong value for iflg ", 1 )
!
CASE ( 12 )
!
DO ig = 1, ng
ca(ig) = psi( nlm( ig ) )
c (ig) = psi( nl( ig ) )
END DO
CASE DEFAULT
!
CALL errore(" psi2c "," wrong value for iflg ", ABS( iflg ) )
END SELECT
return
END SUBROUTINE psi2c
!-----------------------------------------------------------------------
SUBROUTINE psi2rho( grid_type, psi, nnr, rho, ng )
use gvect, only: nlm, nl
use gvecs, only: nlsm, nls
use kinds, only: DP
implicit none
complex(DP) :: psi(*), rho(*)
integer, intent(in) :: nnr, ng
character(len=*), intent(in) :: grid_type
integer :: ig
SELECT CASE ( grid_type )
!
CASE ( 'Smooth' )
!
do ig = 1, ng
rho( ig ) = psi( nls( ig ) )
end do
!
CASE ( 'Dense' )
!
do ig = 1, ng
rho( ig ) = psi( nl( ig ) )
end do
!
CASE DEFAULT
!
CALL errore(" psi2rho "," wrong grid "//grid_type , 1 )
END SELECT
return
END SUBROUTINE psi2rho
!-----------------------------------------------------------------------
SUBROUTINE box2grid(irb,nfft,qv,vr)
......@@ -413,38 +239,3 @@
RETURN
END FUNCTION boxdotgrid
!
!!----------------------------------------------------------------------
! subroutine parabox(nr3b,irb3,nr3,imin3,imax3)
!!----------------------------------------------------------------------
!!
!! find if box grid planes in the z direction have component on the dense
!! grid on this processor, and if, which range imin3-imax3
!!
! use mp_global, only: me_bgrp
! use fft_base, only: dfftp
!! input
! integer nr3b,irb3,nr3
!! output
! integer imin3,imax3
!! local
! integer ir3, ibig3, me
!!
! me = me_bgrp + 1
! imin3=nr3b
! imax3=1
! do ir3=1,nr3b
! ibig3=1+mod(irb3+ir3-2,nr3)
! if(ibig3.lt.1.or.ibig3.gt.nr3) &
! & call errore('cfftpb','ibig3 wrong',ibig3)
! ibig3=ibig3-dfftp%my_i0r3p
! if (ibig3.gt.0.and.ibig3.le.dfftp%my_nr3p) then
! imin3=min(imin3,ir3)
! imax3=max(imax3,ir3)
! end if
! end do
!!
! return
! end subroutine parabox
!
......@@ -38,6 +38,7 @@
USE gvect, ONLY: ngm
USE constants, ONLY: gsmall, pi
USE cell_base, ONLY: tpiba2, s_to_r, alat
USE fft_rho
IMPLICIT NONE
......@@ -49,8 +50,8 @@
! ... Locals
!
COMPLEX(DP), ALLOCATABLE :: grr(:)
COMPLEX(DP), ALLOCATABLE :: grg(:)
REAL(DP), ALLOCATABLE :: grr(:,:)
COMPLEX(DP), ALLOCATABLE :: grg(:,:)
REAL(DP) :: rc, r(3), s(3), rmod, g2, rc2, arg, fact
INTEGER :: ig, i, j, k, ir
INTEGER :: ir1, ir2, ir3, nr3l
......@@ -63,8 +64,8 @@
END DO
nr3l = dfftp%my_nr3p
ALLOCATE( grr( dfftp%nnr ) )
ALLOCATE( grg( SIZE( screen_coul ) ) )
ALLOCATE( grr( dfftp%nnr, 1 ) )
ALLOCATE( grg( dfftp%nnr, 1 ) )
grr = 0.0d0
......@@ -85,9 +86,9 @@
rmod = SQRT( r(1)**2 + r(2)**2 + r(3)**2 )
ir = i + (j-1)*dfftp%nr1x + (k-1)*dfftp%nr1x*dfftp%nr2x
IF( rmod < gsmall ) THEN
grr( ir ) = fact * 2.0d0 * rc / SQRT( pi )
grr( ir, 1 ) = fact * 2.0d0 * rc / SQRT( pi )
ELSE
grr( ir ) = fact * qe_erf( rc * rmod ) / rmod
grr( ir, 1 ) = fact * qe_erf( rc * rmod ) / rmod
END IF
END DO
END DO
......@@ -95,16 +96,15 @@
! grg = FFT( grr )
CALL fwfft( 'Dense', grr, dfftp )
CALL psi2rho( 'Dense', grr, dfftp%nnr, grg, ngm )
CALL rho_r2g( grr, grg )
DO ig = 1, SIZE( screen_coul )
IF( hg(ig) < gsmall ) THEN
screen_coul(ig) = grg(1) - ( - pi / rc2 )
screen_coul(ig) = grg(1,1) - ( - pi / rc2 )
ELSE
g2 = tpiba2 * hg(ig)
arg = - g2 / ( 4.0d0 * rc2 )
screen_coul(ig) = grg(ig) - ( 4.0d0 * pi * EXP( arg ) / g2 )
screen_coul(ig) = grg(ig,1) - ( 4.0d0 * pi * EXP( arg ) / g2 )
END IF
END DO
......
......@@ -27,7 +27,7 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, &
USE ions_base, ONLY: nsp, na, nat, rcmax, compute_eextfor
USE ions_base, ONLY: ind_srt, ind_bck
USE gvecs
USE gvect, ONLY: ngm, nl, nlm
USE gvect, ONLY: ngm
USE cell_base, ONLY: omega, r_to_s
USE cell_base, ONLY: alat, at, tpiba2, h, ainv
USE cell_base, ONLY: ibrav, isotropic !True if volume option is chosen for cell_dofree
......
......@@ -21,7 +21,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
USE electrons_base, ONLY: nspin
USE ions_base, ONLY: na, nsp, amass
USE ions_positions, ONLY: tau0
USE gvect, ONLY: g, gg, ngm, nl, nlm
USE gvect, ONLY: g, gg, ngm
USE gvecs, ONLY: ngms
USE cp_main_variables, only: drhor
USE control_flags, ONLY: tpre
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment