mirror of https://gitlab.com/QEF/q-e.git
fft_wave_wrap - g2r wrapper & meta calls
This commit is contained in:
parent
12386cb285
commit
5ff7a01076
|
@ -32,7 +32,7 @@ MODULE fft_helper_subroutines
|
||||||
tg_get_group_nr3
|
tg_get_group_nr3
|
||||||
! ... Used only in CP
|
! ... Used only in CP
|
||||||
PUBLIC :: fftx_add_threed2oned_gamma, fftx_psi2c_gamma, c2psi_gamma, &
|
PUBLIC :: fftx_add_threed2oned_gamma, fftx_psi2c_gamma, c2psi_gamma, &
|
||||||
fftx_add_field, c2psi_gamma_tg, c2psi_k, c2psi_k_tg
|
fftx_add_field, c2psi_gamma_tg, c2psi_k, c2psi_k_tg, fftx_psi2c_k
|
||||||
PUBLIC :: fft_dist_info
|
PUBLIC :: fft_dist_info
|
||||||
! ... Used only in CP+EXX
|
! ... Used only in CP+EXX
|
||||||
PUBLIC :: fftx_tgcomm
|
PUBLIC :: fftx_tgcomm
|
||||||
|
@ -597,9 +597,9 @@ CONTAINS
|
||||||
IMPLICIT NONE
|
IMPLICIT NONE
|
||||||
!
|
!
|
||||||
TYPE(fft_type_descriptor), INTENT(in) :: desc
|
TYPE(fft_type_descriptor), INTENT(in) :: desc
|
||||||
complex(DP), INTENT(OUT) :: vout1(:)
|
COMPLEX(DP), INTENT(OUT) :: vout1(:)
|
||||||
complex(DP), OPTIONAL, INTENT(OUT) :: vout2(:)
|
COMPLEX(DP), OPTIONAL, INTENT(OUT) :: vout2(:)
|
||||||
complex(DP), INTENT(IN) :: vin(:)
|
COMPLEX(DP), INTENT(IN) :: vin(:)
|
||||||
COMPLEX(DP) :: fp, fm
|
COMPLEX(DP) :: fp, fm
|
||||||
INTEGER :: ig
|
INTEGER :: ig
|
||||||
!
|
!
|
||||||
|
@ -651,6 +651,27 @@ CONTAINS
|
||||||
END IF
|
END IF
|
||||||
END SUBROUTINE fftx_psi2c_gamma_gpu
|
END SUBROUTINE fftx_psi2c_gamma_gpu
|
||||||
!
|
!
|
||||||
|
!------------------------------------------------------------
|
||||||
|
SUBROUTINE fftx_psi2c_k( desc, vin, vout, igk )
|
||||||
|
!---------------------------------------------------------
|
||||||
|
!
|
||||||
|
USE fft_types, ONLY : fft_type_descriptor
|
||||||
|
!
|
||||||
|
TYPE(fft_type_descriptor), INTENT(IN) :: desc
|
||||||
|
COMPLEX(DP), INTENT(IN) :: vin(:)
|
||||||
|
COMPLEX(DP), INTENT(OUT) :: vout(:)
|
||||||
|
INTEGER, INTENT(IN) :: igk(:)
|
||||||
|
!
|
||||||
|
INTEGER :: ig
|
||||||
|
!
|
||||||
|
DO ig = 1, desc%ngw
|
||||||
|
vout(ig) = vin(desc%nl(igk(ig)))
|
||||||
|
ENDDO
|
||||||
|
!
|
||||||
|
RETURN
|
||||||
|
!
|
||||||
|
END SUBROUTINE fftx_psi2c_k
|
||||||
|
!
|
||||||
!--------------------------------------------------------------------
|
!--------------------------------------------------------------------
|
||||||
SUBROUTINE c2psi_gamma_tg( desc, psis, c_bgrp, i, nbsp_bgrp )
|
SUBROUTINE c2psi_gamma_tg( desc, psis, c_bgrp, i, nbsp_bgrp )
|
||||||
!-----------------------------------------------------------------
|
!-----------------------------------------------------------------
|
||||||
|
|
|
@ -13,7 +13,7 @@ MODULE fft_wave
|
||||||
!! This module contains wrapper to FFT and inverse FFTs of w.f.
|
!! This module contains wrapper to FFT and inverse FFTs of w.f.
|
||||||
!
|
!
|
||||||
USE kinds, ONLY: DP
|
USE kinds, ONLY: DP
|
||||||
USE fft_interfaces, ONLY: invfft
|
USE fft_interfaces, ONLY: fwfft, invfft
|
||||||
USE fft_types, ONLY: fft_type_descriptor
|
USE fft_types, ONLY: fft_type_descriptor
|
||||||
USE control_flags, ONLY: gamma_only
|
USE control_flags, ONLY: gamma_only
|
||||||
!
|
!
|
||||||
|
@ -21,9 +21,50 @@ MODULE fft_wave
|
||||||
!
|
!
|
||||||
PRIVATE
|
PRIVATE
|
||||||
!
|
!
|
||||||
PUBLIC :: wave_g2r, tgwave_g2r
|
PUBLIC :: wave_r2g, wave_g2r, tgwave_g2r
|
||||||
!
|
!
|
||||||
CONTAINS
|
CONTAINS
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!----------------------------------------------------------------------
|
||||||
|
SUBROUTINE wave_r2g( f_in, f_out, dfft, igk )
|
||||||
|
!--------------------------------------------------------------------
|
||||||
|
!! Wave function FFT from R to G-space.
|
||||||
|
!
|
||||||
|
USE fft_helper_subroutines, ONLY: fftx_psi2c_gamma, fftx_psi2c_k
|
||||||
|
!
|
||||||
|
IMPLICIT NONE
|
||||||
|
!
|
||||||
|
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
|
||||||
|
COMPLEX(DP), INTENT(IN) :: f_in(:)
|
||||||
|
COMPLEX(DP), INTENT(OUT) :: f_out(:,:)
|
||||||
|
INTEGER, OPTIONAL, INTENT(IN) :: igk(:)
|
||||||
|
!
|
||||||
|
! ... local variables
|
||||||
|
!
|
||||||
|
COMPLEX(DP), ALLOCATABLE :: psic(:)
|
||||||
|
INTEGER :: dim2, nrxxs
|
||||||
|
!
|
||||||
|
nrxxs = SIZE(f_in)
|
||||||
|
dim2 = SIZE(f_out(1,:))
|
||||||
|
!
|
||||||
|
ALLOCATE( psic(nrxxs) )
|
||||||
|
psic = f_in
|
||||||
|
!
|
||||||
|
CALL fwfft( 'Wave', psic, dfft )
|
||||||
|
!
|
||||||
|
IF (gamma_only) THEN
|
||||||
|
IF (dim2==1) CALL fftx_psi2c_gamma( dfft, psic, f_out(:,1) )
|
||||||
|
IF (dim2==2) CALL fftx_psi2c_gamma( dfft, psic, f_out(:,1), f_out(:,2) )
|
||||||
|
ELSE
|
||||||
|
CALL fftx_psi2c_k( dfft, psic, f_out(:,1), igk )
|
||||||
|
ENDIF
|
||||||
|
!
|
||||||
|
DEALLOCATE( psic )
|
||||||
|
!
|
||||||
|
RETURN
|
||||||
|
!
|
||||||
|
END SUBROUTINE wave_r2g
|
||||||
!
|
!
|
||||||
!
|
!
|
||||||
!----------------------------------------------------------------------
|
!----------------------------------------------------------------------
|
||||||
|
@ -80,6 +121,7 @@ CONTAINS
|
||||||
!
|
!
|
||||||
END SUBROUTINE wave_g2r
|
END SUBROUTINE wave_g2r
|
||||||
!
|
!
|
||||||
|
!
|
||||||
!----------------------------------------------------------------------
|
!----------------------------------------------------------------------
|
||||||
SUBROUTINE tgwave_g2r( f_in, f_out, dfft, ibnd, ibnd_end, igk )
|
SUBROUTINE tgwave_g2r( f_in, f_out, dfft, ibnd, ibnd_end, igk )
|
||||||
!--------------------------------------------------------------------
|
!--------------------------------------------------------------------
|
||||||
|
|
|
@ -22,7 +22,7 @@ SUBROUTINE h_psi_meta( ldap, np, mp, psip, hpsi )
|
||||||
USE control_flags, ONLY : gamma_only
|
USE control_flags, ONLY : gamma_only
|
||||||
USE wavefunctions, ONLY : psic
|
USE wavefunctions, ONLY : psic
|
||||||
USE fft_base, ONLY : dffts
|
USE fft_base, ONLY : dffts
|
||||||
USE fft_wave, ONLY : wave_g2r
|
USE fft_wave, ONLY : wave_r2g, wave_g2r
|
||||||
USE fft_interfaces, ONLY : fwfft
|
USE fft_interfaces, ONLY : fwfft
|
||||||
!
|
!
|
||||||
IMPLICIT NONE
|
IMPLICIT NONE
|
||||||
|
@ -40,58 +40,49 @@ SUBROUTINE h_psi_meta( ldap, np, mp, psip, hpsi )
|
||||||
!
|
!
|
||||||
! ... local variables
|
! ... local variables
|
||||||
!
|
!
|
||||||
REAL(DP), ALLOCATABLE :: kplusg(:)
|
COMPLEX(DP), ALLOCATABLE :: psi_g(:,:)
|
||||||
INTEGER :: im, j, nrxxs
|
INTEGER :: im, i, j, nrxxs, ebnd, brange
|
||||||
|
REAL(DP) :: kplusgi, fac
|
||||||
INTEGER :: i, ebnd, brange
|
|
||||||
REAL(DP) :: kplusgi
|
|
||||||
|
|
||||||
COMPLEX(DP), ALLOCATABLE :: kplusg_evc(:,:)
|
|
||||||
COMPLEX(DP), PARAMETER :: ci=(0.d0,1.d0)
|
COMPLEX(DP), PARAMETER :: ci=(0.d0,1.d0)
|
||||||
!
|
!
|
||||||
CALL start_clock( 'h_psi_meta' )
|
CALL start_clock( 'h_psi_meta' )
|
||||||
!
|
!
|
||||||
nrxxs = dffts%nnr
|
nrxxs = dffts%nnr
|
||||||
ALLOCATE( kplusg(np) )
|
!
|
||||||
|
ALLOCATE( psi_g(np,2) )
|
||||||
ALLOCATE( kplusg_evc(np,2) )
|
|
||||||
|
|
||||||
!
|
!
|
||||||
IF (gamma_only) THEN
|
IF (gamma_only) THEN
|
||||||
!
|
!
|
||||||
! ... gamma algorithm
|
! ... Gamma algorithm
|
||||||
!
|
!
|
||||||
DO im = 1, mp, 2
|
DO im = 1, mp, 2
|
||||||
|
!
|
||||||
|
fac = 1.d0
|
||||||
|
IF ( im < mp ) fac = 0.5d0
|
||||||
|
!
|
||||||
DO j = 1, 3
|
DO j = 1, 3
|
||||||
!
|
!
|
||||||
DO i = 1, np
|
DO i = 1, np
|
||||||
kplusgi = (xk(j,current_k)+g(j,i)) * tpiba
|
kplusgi = (xk(j,current_k)+g(j,i)) * tpiba
|
||||||
kplusg_evc(i,1) = CMPLX(0.D0,kplusgi) * psip(i,im)
|
psi_g(i,1) = CMPLX(0.D0,kplusgi) * psip(i,im)
|
||||||
IF ( im < mp ) kplusg_evc(i,2) = CMPLX(0.d0,kplusgi) * psip(i,im+1)
|
IF ( im < mp ) psi_g(i,2) = CMPLX(0.d0,kplusgi) * psip(i,im+1)
|
||||||
ENDDO
|
ENDDO
|
||||||
!
|
!
|
||||||
ebnd = im
|
ebnd = im
|
||||||
IF ( im < mp ) ebnd = ebnd + 1
|
IF ( im < mp ) ebnd = ebnd + 1
|
||||||
brange = ebnd-im+1
|
brange = ebnd-im+1
|
||||||
!
|
!
|
||||||
CALL wave_g2r( kplusg_evc(1:np,1:brange), psic, dffts )
|
CALL wave_g2r( psi_g(1:np,1:brange), psic, dffts )
|
||||||
!
|
!
|
||||||
psic(1:nrxxs) = kedtau(1:nrxxs,current_spin) * psic(1:nrxxs)
|
psic(1:nrxxs) = kedtau(1:nrxxs,current_spin) * psic(1:nrxxs)
|
||||||
!
|
!
|
||||||
CALL fwfft( 'Wave', psic, dffts )
|
CALL wave_r2g( psic, psi_g(:,1:brange), dffts )
|
||||||
!
|
!
|
||||||
|
DO i = 1, np
|
||||||
kplusg (1:np) = (xk(j,current_k)+g(j,1:np)) * tpiba
|
kplusgi = (xk(j,current_k)+g(j,i)) * tpiba
|
||||||
|
hpsi(i,im) = hpsi(i,im) - ci * kplusgi * fac * psi_g(i,1)
|
||||||
IF ( im < mp ) THEN
|
IF ( im < mp ) hpsi(i,im+1) = hpsi(i,im+1) - ci * kplusgi * fac * psi_g(i,2)
|
||||||
hpsi(1:np,im) = hpsi(1:np,im) - ci * kplusg(1:np) * 0.5d0 * &
|
ENDDO
|
||||||
( psic(dffts%nl(1:np)) + CONJG(psic(dffts%nlm(1:np))) )
|
|
||||||
hpsi(1:np,im+1) = hpsi(1:np,im+1) - kplusg(1:np) * 0.5d0 * &
|
|
||||||
( psic(dffts%nl(1:np)) - CONJG(psic(dffts%nlm(1:np))) )
|
|
||||||
ELSE
|
|
||||||
hpsi(1:np,im) = hpsi(1:np,im) - ci * kplusg(1:np) * &
|
|
||||||
psic(dffts%nl(1:np))
|
|
||||||
ENDIF
|
|
||||||
!
|
!
|
||||||
ENDDO
|
ENDDO
|
||||||
ENDDO
|
ENDDO
|
||||||
|
@ -105,28 +96,26 @@ SUBROUTINE h_psi_meta( ldap, np, mp, psip, hpsi )
|
||||||
!
|
!
|
||||||
DO i = 1, np
|
DO i = 1, np
|
||||||
kplusgi = (xk(j,current_k)+g(j,igk_k(i,current_k))) * tpiba
|
kplusgi = (xk(j,current_k)+g(j,igk_k(i,current_k))) * tpiba
|
||||||
kplusg_evc(i,1) = CMPLX(0.D0,kplusgi,kind=DP) * psip(i,im)
|
psi_g(i,1) = CMPLX(0.D0,kplusgi,kind=DP) * psip(i,im)
|
||||||
ENDDO
|
ENDDO
|
||||||
!
|
!
|
||||||
CALL wave_g2r( kplusg_evc(1:np,1:1), psic, dffts, igk=igk_k(:,current_k) )
|
CALL wave_g2r( psi_g(:,1:1), psic, dffts, igk=igk_k(:,current_k) )
|
||||||
!
|
!
|
||||||
psic(1:nrxxs) = kedtau(1:nrxxs,current_spin) * psic(1:nrxxs)
|
psic(1:nrxxs) = kedtau(1:nrxxs,current_spin) * psic(1:nrxxs)
|
||||||
!
|
!
|
||||||
|
CALL wave_r2g( psic, psi_g(:,1:1), dffts, igk=igk_k(:,current_k) )
|
||||||
kplusg (1:np) = (xk(j,current_k)+g(j,igk_k(1:np,current_k)))*tpiba
|
!
|
||||||
|
DO i = 1, np
|
||||||
CALL fwfft( 'Wave', psic, dffts )
|
kplusgi = (xk(j,current_k)+g(j,i)) * tpiba
|
||||||
|
hpsi(i,im) = hpsi(i,im) - CMPLX(0.D0,kplusgi,KIND=DP) * psi_g(i,1)
|
||||||
|
ENDDO
|
||||||
!
|
!
|
||||||
hpsi(1:np,im) = hpsi(1:np,im) - CMPLX(0d0, kplusg(1:np), KIND=DP) &
|
|
||||||
* psic(dffts%nl(igk_k(1:np,current_k)))
|
|
||||||
ENDDO
|
ENDDO
|
||||||
ENDDO
|
ENDDO
|
||||||
!
|
!
|
||||||
ENDIF
|
ENDIF
|
||||||
!
|
!
|
||||||
DEALLOCATE( kplusg_evc )
|
DEALLOCATE( psi_g )
|
||||||
|
|
||||||
DEALLOCATE( kplusg )
|
|
||||||
!
|
!
|
||||||
CALL stop_clock( 'h_psi_meta' )
|
CALL stop_clock( 'h_psi_meta' )
|
||||||
!
|
!
|
||||||
|
|
Loading…
Reference in New Issue