mirror of https://gitlab.com/QEF/q-e.git
- further rho related clean-up
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@13761 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
ccavazzoni
parent
2d32977bb2
commit
d09ac29f40
|
|
@ -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
|
||||
|
|
|
|||
211
CPV/src/fft.f90
211
CPV/src/fft.f90
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue