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

More removal of variables from exx_fft

This commit is contained in:
Paolo Giannozzi 2018-01-01 18:58:31 +01:00
parent 997c8b06eb
commit 02db055030
3 changed files with 27 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Modules/fft_custom.f90
View File

@ -24,13 +24,10 @@ MODULE fft_custom
! ... data structure containing information about "custom" fft grid:
! ... G-vectors and the like - FIXME: to be deleted
REAL(kind=DP) :: ecutt
! Custom cutoff (rydberg)
REAL(kind=DP), DIMENSION(:), POINTER :: ggt
REAL(kind=DP), DIMENSION(:,:),POINTER :: gt
INTEGER :: gstart_t
INTEGER :: npwt
LOGICAL :: initialized = .FALSE.
END TYPE fft_cus
@ -299,22 +296,5 @@ CONTAINS
!
END SUBROUTINE ggent
SUBROUTINE deallocate_fft_custom(fc)
!this subroutine deallocates all the fft custom stuff
USE fft_types, ONLY : fft_type_deallocate
IMPLICIT NONE
TYPE(fft_cus) :: fc
IF(.NOT. fc%initialized) RETURN
IF ( ASSOCIATED (fc%gt) ) DEALLOCATE(fc%gt)
IF ( ASSOCIATED (fc%ggt) ) DEALLOCATE(fc%ggt)
fc%initialized=.FALSE.
RETURN
END SUBROUTINE deallocate_fft_custom
!----------------------------------------------------------------------------
END MODULE fft_custom

15
PW/src/exx.f90
View File

@ -144,6 +144,7 @@ MODULE exx
!
TYPE ( fft_type_descriptor ) :: dfftt
TYPE(fft_cus) :: exx_fft
LOGICAL :: exx_fft_initialized = .FALSE.
INTEGER :: ngmt_g
REAL(DP) :: ecutfock ! energy cutoff for custom grid
!
@ -228,13 +229,11 @@ MODULE exx
REAL(dp) :: gkcut, gcutmt
LOGICAL :: lpara
IF( exx_fft%initialized) RETURN
IF( exx_fft_initialized) RETURN
!
! Initialise the custom grid that allows us to put the wavefunction
! onto the new (smaller) grid for \rho=\psi_{k+q}\psi^*_k and vice versa
!
exx_fft%ecutt=ecutwfc
!
! gkcut is such that all |k+G|^2 < gkcut (in units of (2pi/a)^2)
! Note that with k-points, gkcut > ecutwfc/(2pi/a)^2
! gcutmt is such that |q+G|^2 < gcutmt
@ -286,7 +285,7 @@ MODULE exx
WRITE( stdout, '(/5x,"EXX grid: ",i8," G-vectors", 5x, &
& "FFT dimensions: (",i4,",",i4,",",i4,")")') ngmt_g, &
& dfftt%nr1, dfftt%nr2, dfftt%nr3
exx_fft%initialized = .true.
exx_fft_initialized = .true.
!
IF(tqr) THEN
IF(ecutfock==ecutrho) THEN
@ -309,11 +308,11 @@ MODULE exx
!
USE becmod, ONLY : deallocate_bec_type, is_allocated_bec_type, bec_type
USE us_exx, ONLY : becxx
USE fft_custom, ONLY : deallocate_fft_custom
!
IMPLICIT NONE
INTEGER :: ikq
!
exx_grid_initialized = .false.
IF ( allocated(index_xkq) ) DEALLOCATE(index_xkq)
IF ( allocated(index_xk ) ) DEALLOCATE(index_xk )
IF ( allocated(index_sym) ) DEALLOCATE(index_sym)
@ -334,8 +333,10 @@ MODULE exx
ENDIF
!
IF ( allocated(working_pool) ) DEALLOCATE(working_pool)
CALL deallocate_fft_custom(exx_fft)
exx_grid_initialized = .false.
!
exx_fft_initialized = .false.
IF ( ASSOCIATED (exx_fft%gt) ) DEALLOCATE(exx_fft%gt)
IF ( ASSOCIATED (exx_fft%ggt) ) DEALLOCATE(exx_fft%ggt)
!
!------------------------------------------------------------------------
END SUBROUTINE deallocate_exx

42
TDDFPT/src/lr_exx_kernel.f90
View File

@ -248,8 +248,8 @@ SUBROUTINE lr_exx_revc0_init(orbital, ik)
!
DO ibnd=1,nbnd,2
!
CALL invfft_orbital_custom_gamma(orbital(:,:,1), ibnd, nbnd,&
& exx_fft, dfftt)
CALL invfft_orbital_custom_gamma(orbital(:,:,1), ibnd, nbnd, &
exx_fft%npwt, dfftt)
red_revc0(1:nnr_,ibnd,1)=psic(1:nnr_)
!
ENDDO
@ -399,8 +399,8 @@ SUBROUTINE lr_exx_kernel_noint ( evc, int_vect )
!
DO ibnd=ibnd_start_gamma,ibnd_end_gamma,2
!
CALL invfft_orbital_custom_gamma(evc(:,:,1), ibnd, nbnd,&
& exx_fft, dfftt)
CALL invfft_orbital_custom_gamma(evc(:,:,1), ibnd, nbnd, &
exx_fft%npwt, dfftt)
!
w1=wg(ibnd,1)/omega
!
@ -430,8 +430,8 @@ SUBROUTINE lr_exx_kernel_noint ( evc, int_vect )
IF (ibnd==nbnd) psic(1:nrxxs)=CMPLX(revc_int(1:nrxxs,ibnd)&
&,0.d0,dp)
!
CALL fwfft_orbital_custom_gamma (int_vect(:,:,1), ibnd, nbnd,&
& exx_fft,dfftt)
CALL fwfft_orbital_custom_gamma (int_vect(:,:,1), ibnd, nbnd, &
exx_fft%npwt, dfftt)
!
ENDDO
!
@ -628,7 +628,7 @@ SUBROUTINE lr_exx_kernel_int ( orbital, ibnd, nbnd, ikk )
!
IF( gamma_only ) THEN
!
CALL invfft_orbital_custom_gamma( orbital, ibnd, nbnd, exx_fft, dfftt )
CALL invfft_orbital_custom_gamma( orbital, ibnd, nbnd, exx_fft%npwt, dfftt )
!
w1=wg(ibnd,1)/omega
!
@ -1045,32 +1045,30 @@ END FUNCTION k2d_term_k
!! moved somewhere else but for now they live here.
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE invfft_orbital_custom_gamma(orbital, ibnd, nbnd, g2r, dfftt)
SUBROUTINE invfft_orbital_custom_gamma(orbital, ibnd, nbnd, npwt, dfftt)
USE kinds, ONLY : DP
USE fft_custom, ONLY : fft_cus
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
COMPLEX(DP), INTENT(IN) :: orbital(:,:)
INTEGER, INTENT(IN) :: ibnd, nbnd
TYPE(fft_cus), INTENT(IN) :: g2r
INTEGER, INTENT(IN) :: ibnd, nbnd, npwt
TYPE(fft_type_descriptor), INTENT(IN) :: dfftt
!
psic=(0.0_dp, 0.0_dp)
!
IF (ibnd < nbnd) THEN
!
psic(dfftt%nl(1:g2r%npwt)) = orbital(1:g2r%npwt,ibnd) + &
&(0.0_dp, 1.0_dp) * orbital(1:g2r%npwt,ibnd+1)
psic(dfftt%nlm(1:g2r%npwt)) = CONJG(orbital(1:g2r%npwt,ibnd) - &
&(0.0_dp, 1.0_dp) * orbital(1:g2r%npwt,ibnd+1))
psic(dfftt%nl(1:npwt)) = orbital(1:npwt,ibnd) + &
&(0.0_dp, 1.0_dp) * orbital(1:npwt,ibnd+1)
psic(dfftt%nlm(1:npwt)) = CONJG(orbital(1:npwt,ibnd) - &
&(0.0_dp, 1.0_dp) * orbital(1:npwt,ibnd+1))
!
ELSE
!
psic(dfftt%nl(1:g2r%npwt)) = orbital(1:g2r%npwt,ibnd)
psic(dfftt%nlm(1:g2r%npwt)) =CONJG(orbital(1:g2r%npwt,ibnd))
psic(dfftt%nl(1:npwt)) = orbital(1:npwt,ibnd)
psic(dfftt%nlm(1:npwt)) =CONJG(orbital(1:npwt,ibnd))
!
ENDIF
!
@ -1080,17 +1078,15 @@ SUBROUTINE invfft_orbital_custom_gamma(orbital, ibnd, nbnd, g2r, dfftt)
!
END SUBROUTINE invfft_orbital_custom_gamma
SUBROUTINE fwfft_orbital_custom_gamma(orbital, ibnd, nbnd, g2r, dfftt)
SUBROUTINE fwfft_orbital_custom_gamma(orbital, ibnd, nbnd, npwt, dfftt)
USE kinds, ONLY : DP
USE fft_custom, ONLY : fft_cus
USE fft_types, ONLY : fft_type_descriptor
IMPLICIT NONE
COMPLEX(DP), INTENT(INOUT) :: orbital(:,:)
INTEGER, INTENT(IN) :: ibnd, nbnd
TYPE(fft_cus), INTENT(IN) :: g2r
INTEGER, INTENT(IN) :: ibnd, nbnd, npwt
TYPE(fft_type_descriptor), INTENT(IN) :: dfftt
! Workspaces
@ -1103,7 +1099,7 @@ SUBROUTINE fwfft_orbital_custom_gamma(orbital, ibnd, nbnd, g2r, dfftt)
IF (ibnd < nbnd) THEN
!
! two ffts at the same time
DO j = 1, g2r%npwt
DO j = 1, npwt
fp = (psic(dfftt%nl(j)) + psic(dfftt%nlm(j)))*0.5d0
fm = (psic(dfftt%nl(j)) - psic(dfftt%nlm(j)))*0.5d0
orbital( j, ibnd) = CMPLX( DBLE(fp), AIMAG(fm),kind=DP)
@ -1112,7 +1108,7 @@ SUBROUTINE fwfft_orbital_custom_gamma(orbital, ibnd, nbnd, g2r, dfftt)
!
ELSE
!
orbital(1:g2r%npwt,ibnd)=psic(dfftt%nl(1:g2r%npwt))
orbital(1:npwt,ibnd)=psic(dfftt%nl(1:npwt))
!
ENDIF
!