quantum-espresso/Modules/fft_wave.f90

!
! Copyright (C) Quantum ESPRESSO group
!
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!=---------------------------------------------------------------------------=!
!
MODULE fft_wave
  !
  !! This module contains wrappers to FFT and inverse FFTs of the wave function,
  !! which it enclose the calls to g-vect/FFT-grid transposition routines too.
  !
  USE kinds,           ONLY: DP
  USE fft_interfaces,  ONLY: fwfft, invfft
  USE fft_types,       ONLY: fft_type_descriptor
  USE control_flags,   ONLY: gamma_only, many_fft
  !
  IMPLICIT NONE
  !
  PRIVATE
  !
  PUBLIC :: wave_r2g, wave_g2r, tgwave_r2g, tgwave_g2r
  !
  !
CONTAINS
  !
  !----------------------------------------------------------------------
  SUBROUTINE wave_r2g( f_in, f_out, dfft, igk, howmany_set )
    !--------------------------------------------------------------------
    !! Wave function FFT from R to G-space.
    !
    USE fft_helper_subroutines,  ONLY: fftx_psi2c_gamma, fftx_psi2c_k
    USE control_flags,           ONLY: many_fft
    !
    IMPLICIT NONE
    !
    TYPE(fft_type_descriptor), INTENT(IN) :: dfft
    !! FFT descriptor
    COMPLEX(DP) :: f_in(:)
    !! input: r-space wave-function
    COMPLEX(DP), INTENT(OUT) :: f_out(:,:)
    !! output: g-space wave-function
    INTEGER, OPTIONAL, INTENT(IN) :: igk(:)
    !! index of G corresponding to a given index of k+G
    INTEGER, OPTIONAL, INTENT(IN) :: howmany_set(3)
    !! gpu-enabled only (many_fft>1 case):  
    !! (1) group_size;  
    !! (2) true dimension of psi;  
    !! (3) howmany (if gamma) or group_size (if k).
    !
    ! ... local variables
    INTEGER :: dim1, dim2
    !
    dim1 = SIZE(f_in(:))
    dim2 = SIZE(f_out(1,:))
    !
    !$acc data present_or_copyin(f_in) present_or_copyout(f_out)
    !
    !$acc host_data use_device(f_in)
    IF (PRESENT(howmany_set)) THEN
      CALL fwfft( 'Wave', f_in, dfft, howmany=howmany_set(3) )
    ELSE
      CALL fwfft( 'Wave', f_in, dfft )
    ENDIF
    !$acc end host_data
    !
    IF (gamma_only) THEN
      IF (PRESENT(howmany_set)) THEN
        CALL fftx_psi2c_gamma( dfft, f_in, f_out, howmany_set=howmany_set(1:2) )
      ELSE
        IF (dim2==1) CALL fftx_psi2c_gamma( dfft, f_in, f_out(:,1:1) )
        IF (dim2==2) CALL fftx_psi2c_gamma( dfft, f_in, f_out(:,1:1), &
                                                         vout2=f_out(:,2) )             
      ENDIF
    ELSE
      !$acc data present_or_copyin(igk)
      IF (PRESENT(howmany_set)) THEN
        CALL fftx_psi2c_k( dfft, f_in, f_out, igk, howmany_set(1:2) )
      ELSE
        CALL fftx_psi2c_k( dfft, f_in, f_out(:,1:1), igk )
      ENDIF
      !$acc end data
    ENDIF
    !
    !$acc end data
    !
    RETURN
    !
  END SUBROUTINE wave_r2g
  !
  !
  !----------------------------------------------------------------------
  SUBROUTINE wave_g2r( f_in, f_out, dfft, igk, howmany_set )
    !--------------------------------------------------------------------
    !! Wave function FFT from G to R-space.
    !
    USE fft_helper_subroutines, ONLY: fftx_c2psi_gamma, fftx_c2psi_k
    !
    IMPLICIT NONE
    !
    TYPE(fft_type_descriptor), INTENT(IN) :: dfft
    !! FFT wave descriptor
    COMPLEX(DP), INTENT(IN) :: f_in(:,:)
    !! input: g-space wave-function
    COMPLEX(DP) :: f_out(:)
    !! output: r-space wave-function
    INTEGER, OPTIONAL, INTENT(IN) :: igk(:)
    !! index of G corresponding to a given index of k+G
    INTEGER, OPTIONAL, INTENT(IN) :: howmany_set(3)
    !! gpu-enabled only (many_fft>1 case):  
    !! (1) group_size;  
    !! (2) true dimension of psi;  
    !! (3) howmany (if gamma) or group_size (if k).
    !
    ! ... local variables
    INTEGER :: npw, dim2
    !
    !$acc data present_or_copyin(f_in) present_or_copyout(f_out)
    !
    npw  = SIZE(f_in(:,1))
    dim2 = SIZE(f_in(1,:))
    !
    IF (gamma_only) THEN
      !
      IF (PRESENT(howmany_set)) THEN
        CALL fftx_c2psi_gamma( dfft, f_out, f_in, howmany_set=howmany_set(1:2) )
      ELSE
        IF (dim2/=2) CALL fftx_c2psi_gamma( dfft, f_out, f_in(:,1:1) )
        IF (dim2==2) CALL fftx_c2psi_gamma( dfft, f_out, f_in(:,1:1), ca=f_in(:,2) )
      ENDIF
      !
    ELSE
      !
      !$acc data present_or_copyin(igk)
      IF (PRESENT(howmany_set)) THEN     !only when ACC is active
        npw = howmany_set(2)
        CALL fftx_c2psi_k( dfft, f_out, f_in, igk, npw, howmany_set(1) )
      ELSE
        CALL fftx_c2psi_k( dfft, f_out, f_in, igk, npw )
      ENDIF
      !$acc end data
      !
    ENDIF
    !
    !$acc host_data use_device( f_out )
    IF (PRESENT(howmany_set)) THEN
      CALL invfft( 'Wave', f_out, dfft, howmany=howmany_set(3) )
    ELSE
      CALL invfft( 'Wave', f_out, dfft )
    ENDIF
    !$acc end host_data
    !
    !$acc end data
    !
    RETURN
    !
  END SUBROUTINE wave_g2r
  !
  !
  !----------------------------------------------------------------------
  SUBROUTINE tgwave_g2r( f_in, f_out, dfft, n, igk )
    !--------------------------------------------------------------------
    !! Wave function FFT from G to R-space. Task-group version.
    !
    USE fft_helper_subroutines,  ONLY: fftx_c2psi_gamma_tg, fftx_c2psi_k_tg
    !
    IMPLICIT NONE
    !
    TYPE(fft_type_descriptor), INTENT(IN) :: dfft
    !! FFT descriptor
    COMPLEX(DP) :: f_in(:,:)
    !! input: wave in g-space - task group chunk
    COMPLEX(DP) :: f_out(:)
    !! output: wave in r-space - task group chunk
    INTEGER, INTENT(IN) :: n
    !! true dimension of f_in
    INTEGER, OPTIONAL, INTENT(IN) :: igk(:)
    !! index of G corresponding to a given index of k+G
    !
    ! ... local variables
    INTEGER :: npw, dbnd
    !
    !$acc data present_or_copyin(f_in,igk) present_or_copyout(f_out)
    !
    npw = SIZE(f_in(:,1))
    dbnd = SIZE(f_in(1,:))
    IF (n/=npw) npw = n
    !
    !$acc kernels
    f_out(:) = (0.D0,0.D0)
    !$acc end kernels
    !
    IF (gamma_only) THEN
      CALL fftx_c2psi_gamma_tg( dfft, f_out, f_in, npw, dbnd )
    ELSE
      CALL fftx_c2psi_k_tg( dfft, f_out, f_in, igk, npw, dbnd )
    ENDIF
    !
    !$acc host_data use_device(f_out)
    CALL invfft( 'tgWave', f_out, dfft )
    !$acc end host_data
    !
    !$acc end data
    !
    RETURN
    !
  END SUBROUTINE tgwave_g2r
  !
  !
  !----------------------------------------------------------------------
  SUBROUTINE tgwave_r2g( f_in, f_out, dfft, n, igk )
    !--------------------------------------------------------------------
    !! Wave function FFT from R to G-space. Task-group version.
    !
    USE fft_helper_subroutines,  ONLY: fftx_psi2c_gamma_tg, fftx_psi2c_k_tg
    !
    IMPLICIT NONE
    !
    TYPE(fft_type_descriptor), INTENT(IN) :: dfft
    !! FFT descriptor
    COMPLEX(DP) :: f_in(:)
    !! input: wave in g-space - task group chunk
    COMPLEX(DP), INTENT(OUT) :: f_out(:,:)
    !! output: wave in r-space - task group chunk
    INTEGER, INTENT(IN) :: n
    !! true dimension of f_out
    INTEGER, OPTIONAL, INTENT(IN) :: igk(:)
    !! index of G corresponding to a given index of k+G
    !
    ! ... local variables
    INTEGER :: dbnd
    !
    dbnd = SIZE(f_out(1,:))
    !
    !$acc data present_or_copyin(f_in) present_or_copyout(f_out)
    !
    !$acc host_data use_device(f_in)
    CALL fwfft( 'tgWave', f_in, dfft )
    !$acc end host_data
    !
    IF (gamma_only) THEN
      CALL fftx_psi2c_gamma_tg( dfft, f_in, f_out, n, dbnd )
    ELSE
      CALL fftx_psi2c_k_tg( dfft, f_in, f_out, igk, n, dbnd )
    ENDIF
    !
    !$acc end data
    !
    RETURN
    !
  END SUBROUTINE tgwave_r2g
  !
  !
END MODULE fft_wave