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

- more code merge in fft_rho

This commit is contained in:
Carlo Cavazzoni 2018-01-03 22:07:27 +01:00
parent 1cd21f1d1f
commit b028caedef
7 changed files with 39 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CPV/src/chargedensity.f90
View File

@ -195,7 +195,7 @@
TRIM(tmp_dir), TRIM(prefix), ndr
CALL read_rhog ( dirname, root_bgrp, intra_bgrp_comm, &
ig_l2g, nspin, rhog )
CALL rho_g2r ( rhog, rhor )
CALL rho_g2r ( dfftp, rhog, rhor )
#endif
rhopr = rhor
first = .FALSE.
@ -255,7 +255,7 @@
!
rhog(dffts%ngm+1:,:) = 0.0d0
!
CALL rho_g2r( rhog, rhor )
CALL rho_g2r( dfftp, rhog, rhor )
!
IF ( dft_is_meta() ) THEN
CALL kedtauofr_meta( c_bgrp ) ! METAGGA

4
CPV/src/cplib_meta.f90
View File

@ -192,7 +192,7 @@
!
kedtaug(dffts%ngm+1:,:) = 0.0d0
CALL rho_g2r( kedtaug, kedtaur )
CALL rho_g2r( dfftp, kedtaug, kedtaur )
!
return
end subroutine kedtauofr_meta
@ -258,7 +258,7 @@
!
CALL rho_r2g( dfftp, kedtaur, kedtaug )
!
CALL smooth_rho_g2r ( kedtaug, kedtaus )
CALL rho_g2r ( dffts, kedtaug, kedtaus )
!calculate dkedxc in real space on smooth grids !metagga
if(tpre) then

4
CPV/src/vofrho.f90
View File

@ -474,7 +474,7 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, &
! fourier transform of total potential to r-space (dense grid)
! -------------------------------------------------------------------
CALL rho_g2r( rhog, rhor )
CALL rho_g2r( dfftp, rhog, rhor )
IF(nspin.EQ.1) THEN
vave=SUM(rhor(:,1))/DBLE( dfftp%nr1* dfftp%nr2* dfftp%nr3)
@ -489,7 +489,7 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, &
!
! fourier transform of total potential to r-space (smooth grid)
!
CALL smooth_rho_g2r ( rhog, rhos )
CALL rho_g2r ( dffts, rhog, rhos )
IF( dft_is_meta() ) CALL vofrho_meta( )

2
CPV/src/vol_clu.f90
View File

@ -244,7 +244,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,flag)
if (abisur) &
& call gradrho(nspin,rhotmp,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
CALL rho_g2r( rhotmp, rho_gaus )
CALL rho_g2r( dfftp, rhotmp, rho_gaus )
deallocate(rhotmp)
e_j = 0.d0

110
Modules/fft_rho.f90
View File

@ -17,7 +17,7 @@ MODULE fft_rho
!
IMPLICIT NONE
PRIVATE
PUBLIC :: rho_r2g, rho_g2r, smooth_rho_g2r
PUBLIC :: rho_r2g, rho_g2r
!
INTERFACE rho_g2r
MODULE PROCEDURE rho_g2r_x, rho_g2r_sum_components
@ -75,10 +75,11 @@ CONTAINS
END SUBROUTINE rho_r2g
!
SUBROUTINE rho_g2r_x ( rhog, rhor )
USE fft_base, ONLY: dfftp
SUBROUTINE rho_g2r_x ( desc, rhog, rhor )
USE fft_types, ONLY: fft_type_descriptor
USE fft_helper_subroutines, ONLY: fftx_threed2oned, fftx_oned2threed
!
TYPE(fft_type_descriptor), INTENT(in) :: desc
COMPLEX(dp), INTENT(in ):: rhog(:,:)
REAL(dp), INTENT(out):: rhor(:,:)
!
@ -89,24 +90,24 @@ CONTAINS
nspin= SIZE (rhog, 2)
ALLOCATE( psi( dfftp%nnr ) )
ALLOCATE( psi( desc%nnr ) )
IF ( gamma_only ) THEN
IF( nspin == 1 ) THEN
iss=1
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Rho',psi, dfftp )
CALL fftx_oned2threed( desc, psi, rhog(:,iss) )
CALL invfft('Rho',psi, desc )
!$omp parallel do
DO ir=1,dfftp%nnr
DO ir=1,desc%nnr
rhor(ir,iss)=DBLE(psi(ir))
END DO
!$omp end parallel do
ELSE
isup=1
isdw=2
CALL fftx_oned2threed( dfftp, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Rho',psi, dfftp )
CALL fftx_oned2threed( desc, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Rho',psi, desc )
!$omp parallel do
DO ir=1,dfftp%nnr
DO ir=1,desc%nnr
rhor(ir,isup)= DBLE(psi(ir))
rhor(ir,isdw)=AIMAG(psi(ir))
END DO
@ -116,10 +117,10 @@ CONTAINS
ELSE
!
DO iss=1, nspin
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Rho',psi, dfftp )
CALL fftx_oned2threed( desc, psi, rhog(:,iss) )
CALL invfft('Rho',psi, desc )
!$omp parallel do
DO ir=1,dfftp%nnr
DO ir=1,desc%nnr
rhor(ir,iss)=DBLE(psi(ir))
END DO
!$omp end parallel do
@ -130,10 +131,11 @@ CONTAINS
END SUBROUTINE rho_g2r_x
!
SUBROUTINE rho_g2r_sum_components ( rhog, rhor )
USE fft_base, ONLY: dfftp
SUBROUTINE rho_g2r_sum_components ( desc, rhog, rhor )
USE fft_types, ONLY: fft_type_descriptor
USE fft_helper_subroutines, ONLY: fftx_threed2oned, fftx_oned2threed
!
TYPE(fft_type_descriptor), INTENT(in) :: desc
COMPLEX(dp), INTENT(in ):: rhog(:,:)
REAL(dp), INTENT(out):: rhor(:)
!
@ -144,24 +146,24 @@ CONTAINS
nspin= SIZE (rhog, 2)
ALLOCATE( psi( dfftp%nnr ) )
ALLOCATE( psi( desc%nnr ) )
IF ( gamma_only ) THEN
IF( nspin == 1 ) THEN
iss=1
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Rho',psi, dfftp )
CALL fftx_oned2threed( desc, psi, rhog(:,iss) )
CALL invfft('Rho',psi, desc )
!$omp parallel do
DO ir=1,dfftp%nnr
DO ir=1,desc%nnr
rhor(ir)=DBLE(psi(ir))
END DO
!$omp end parallel do
ELSE
isup=1
isdw=2
CALL fftx_oned2threed( dfftp, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Rho',psi, dfftp )
CALL fftx_oned2threed( desc, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Rho',psi, desc )
!$omp parallel do
DO ir=1,dfftp%nnr
DO ir=1,desc%nnr
rhor(ir)= DBLE(psi(ir))+AIMAG(psi(ir))
END DO
!$omp end parallel do
@ -170,17 +172,17 @@ CONTAINS
ELSE
!
DO iss=1, nspin
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Rho',psi, dfftp )
CALL fftx_oned2threed( desc, psi, rhog(:,iss) )
CALL invfft('Rho',psi, desc )
IF( iss == 1 ) THEN
!$omp parallel do
DO ir=1,dfftp%nnr
DO ir=1,desc%nnr
rhor(ir)=DBLE(psi(ir))
END DO
!$omp end parallel do
ELSE
!$omp parallel do
DO ir=1,dfftp%nnr
DO ir=1,desc%nnr
rhor(ir)=rhor(ir) + DBLE(psi(ir))
END DO
!$omp end parallel do
@ -192,60 +194,4 @@ CONTAINS
END SUBROUTINE rho_g2r_sum_components
SUBROUTINE smooth_rho_g2r ( rhog, rhor )
USE fft_base, ONLY: dffts
USE fft_helper_subroutines, ONLY: fftx_threed2oned, fftx_oned2threed
!
COMPLEX(dp), INTENT(in ):: rhog(:,:)
REAL(dp), INTENT(out):: rhor(:,:)
!
INTEGER :: ir, ig, iss, isup, isdw
INTEGER :: nspin
COMPLEX(dp), PARAMETER :: ci=(0.0_dp, 1.0_dp)
COMPLEX(dp), ALLOCATABLE :: psi(:)
nspin= SIZE (rhog, 2)
ALLOCATE( psi( dffts%nnr ) )
IF ( gamma_only ) THEN
IF( nspin == 1 ) THEN
iss=1
CALL fftx_oned2threed( dffts, psi, rhog(:,iss) )
CALL invfft('Rho',psi, dffts )
!$omp parallel do
DO ir=1,dffts%nnr
rhor(ir,iss)=DBLE(psi(ir))
END DO
!$omp end parallel do
ELSE
isup=1
isdw=2
CALL fftx_oned2threed( dffts, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Rho',psi, dffts )
!$omp parallel do
DO ir=1,dffts%nnr
rhor(ir,isup)= DBLE(psi(ir))
rhor(ir,isdw)=AIMAG(psi(ir))
END DO
!$omp end parallel do
ENDIF
!
ELSE
!
DO iss=1, nspin
CALL fftx_oned2threed( dffts, psi, rhog(:,iss) )
CALL invfft('Rho',psi, dffts )
!$omp parallel do
DO ir=1,dffts%nnr
rhor(ir,iss)=DBLE(psi(ir))
END DO
!$omp end parallel do
END DO
END IF
DEALLOCATE( psi )
END SUBROUTINE smooth_rho_g2r
END MODULE fft_rho

6
PW/src/potinit.f90
View File

@ -89,7 +89,7 @@ SUBROUTINE potinit()
IF ( .NOT.lforcet ) THEN
CALL read_scf ( rho, nspin, gamma_only )
#if !defined (__OLDXML)
CALL rho_g2r ( rho%of_g, rho%of_r )
CALL rho_g2r ( dfftp, rho%of_g, rho%of_r )
#endif
ELSE
!
@ -101,7 +101,7 @@ SUBROUTINE potinit()
#else
CALL read_rhog ( dirname, root_bgrp, intra_bgrp_comm, &
ig_l2g, nspin, rho%of_g, gamma_only )
CALL rho_g2r ( rho%of_g, rho%of_r )
CALL rho_g2r ( dfftp, rho%of_g, rho%of_r )
#endif
CALL nc_magnetization_from_lsda ( dfftp%nnr, nspin, rho%of_r )
END IF
@ -157,7 +157,7 @@ SUBROUTINE potinit()
#else
CALL read_rhog ( dirname, root_bgrp, intra_bgrp_comm, &
ig_l2g, nspin, v%of_g, gamma_only )
CALL rho_g2r ( v%of_g, v%of_r )
CALL rho_g2r ( dfftp, v%of_g, v%of_r )
#endif
!
WRITE( UNIT = stdout, &

2
PW/src/read_file_new.f90
View File

@ -305,7 +305,7 @@ SUBROUTINE read_xml_file ( )
#if ! defined (__OLDXML)
! FIXME: for compatibility. rho was previously read and written in real space
! FIXME: now it is in G space - to be removed together with old format
CALL rho_g2r ( rho%of_g, rho%of_r )
CALL rho_g2r ( dfftp, rho%of_g, rho%of_r )
#endif
!
! ... re-calculate the local part of the pseudopotential vltot