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

new interface to fft calls 

three types of calls are possibles :  'Rho', 'Wave', 'tgWave'

   In order to enable an fft-type for a given grid the corresponding clock_labels must be set.
   One gives a name to desc%rho_clock_lable for 'Rho' type fft and a name to
   desc%wave_clock_lable for 'Wave' and 'tgWave' types. Whether tg is
   possible depends of the already defined value of desc%have_task_groups variable (mispell to be corrected soon).

   definining
      dffts%rho_clock_label='ffts', dffts%wave_clock_label='fftw',
      dfftp%rho_clock_label='fft', dfftt%rho_clock_label='fftc' and
      dfftt%wave_clock_label='fftcw'
   and changing
      'Dense'->'Rho', 'Smooth'->'Rho', 'Custom'->'Rho', 'CustomWave'->'Wave'
   the same clock names and the same overall behavior as with the old interface is obtained.
This commit is contained in:
Stefano de Gironcoli 2018-01-02 17:45:45 +01:00
parent 761dd6f6bf
commit 41e91c0dac
91 changed files with 498 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
CPV/src/chargedensity.f90
View File

@ -569,7 +569,7 @@
!$omp end parallel
CALL fftx_oned2threed( dfftp, v, drho(:,1) )
!
call invfft( 'Dense', v, dfftp )
call invfft( 'Rho', v, dfftp )
!
!$omp parallel default(shared), private(ig,ir)
!$omp do
@ -580,7 +580,7 @@
CALL fftx_oned2threed( dfftp, v, drho(:,2), drho(:,3) )
!
call invfft( 'Dense', v, dfftp )
call invfft( 'Rho', v, dfftp )
!
!$omp parallel do default(shared)
do ir=1,dfftp%nnr
@ -840,7 +840,7 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
drhor(ir,iss,i,j) = drhor(ir,iss,i,j) + DBLE(v(ir))
END DO
!
CALL fwfft( 'Dense', v, dfftp )
CALL fwfft( 'Rho', v, dfftp )
CALL fftx_add_threed2oned_gamma( dfftp, v, drhog(:,iss,i,j) )
!
ENDDO
@ -915,7 +915,7 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
drhor(ir,isdw,i,j) = drhor(ir,isdw,i,j) +AIMAG(v(ir))
ENDDO
!
CALL fwfft('Dense', v, dfftp )
CALL fwfft('Rho', v, dfftp )
CALL fftx_add_threed2oned_gamma( dfftp, v, drhog(:,isup,i,j), drhog(:,isdw,i,j) )
END DO
@ -1140,7 +1140,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
& ' rhov: int n_v(r) dr = ',omega*ca/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
ENDIF
!
CALL fwfft('Dense',v, dfftp )
CALL fwfft('Rho',v, dfftp )
!
IF( iverbosity > 1 ) THEN
WRITE( stdout,*) ' rhov: smooth ',omega*rhog(1,iss)
@ -1233,7 +1233,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
WRITE( stdout,'(a,2f12.8)') 'rhov:in n_v ',omega*ca/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
ENDIF
!
CALL fwfft('Dense',v, dfftp )
CALL fwfft('Rho',v, dfftp )
!
IF( iverbosity > 1 ) THEN
WRITE( stdout,*) 'rhov: smooth up',omega*rhog(1,isup)

2
CPV/src/cplib.f90
View File

@ -1502,7 +1502,7 @@ END SUBROUTINE print_lambda_x
!
IF( nspin > 1 ) vxc(:) = vxc(:) + vxcr(:,2)
!
CALL fwfft( 'Dense', vxc, dfftp )
CALL fwfft( 'Rho', vxc, dfftp )
CALL fftx_threed2oned( dfftp, vxc, vxg )
!
DO i=1,3

6
CPV/src/exch_corr.f90
View File

@ -304,7 +304,7 @@
do ir=1,dfftp%nnr
v(ir)=CMPLX(gradr(ir,1,iss),0.d0,kind=DP)
end do
call fwfft('Dense',v, dfftp )
call fwfft('Rho',v, dfftp )
CALL fftx_threed2oned( dfftp, v, vp )
do ig=1,ngm
x(ig)=ci*tpiba*g(1,ig)*vp(ig)
@ -326,7 +326,7 @@
do ir=1,dfftp%nnr
v(ir)=CMPLX(gradr(ir,2,iss),gradr(ir,3,iss),kind=DP)
end do
call fwfft('Dense',v, dfftp )
call fwfft('Rho',v, dfftp )
CALL fftx_threed2oned( dfftp, v, vp, vm )
!
do ig=1,ngm
@ -350,7 +350,7 @@
! second part xc-potential: 1 inverse fft
!
CALL fftx_oned2threed( dfftp, v, x )
call invfft('Dense',v, dfftp )
call invfft('Rho',v, dfftp )
do ir=1,dfftp%nnr
rhor(ir,iss)=rhor(ir,iss)-DBLE(v(ir))
end do

12
CPV/src/gradrho.f90
View File

@ -54,12 +54,12 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
drhog(ig,3) = ci*tpiba*g(3,ig)*rhog(ig,iss)
enddo
CALL fftx_oned2threed(dfftp, v, drhog(:,1) )
call invfft('Dense',v, dfftp )
call invfft('Rho',v, dfftp )
do ir=1,dfftp%nnr
drho(1,ir)=drho(1,ir)+real(v(ir))
end do
CALL fftx_oned2threed(dfftp, v, drhog(:,2), drhog(:,3) )
call invfft('Dense',v, dfftp )
call invfft('Rho',v, dfftp )
do ir=1,dfftp%nnr
drho(2,ir)=drho(2,ir)+real(v(ir))
drho(3,ir)=drho(3,ir)+aimag(v(ir))
@ -71,12 +71,12 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
drhog(ig,3) = -1.d0*tpiba**2*g(3,ig)**2*rhog(ig,iss)
enddo
CALL fftx_oned2threed(dfftp, v, drhog(:,1) )
call invfft('Dense',v, dfftp )
call invfft('Rho',v, dfftp )
do ir=1,dfftp%nnr
d2rho(1,ir)=d2rho(1,ir)+real(v(ir))
end do
CALL fftx_oned2threed(dfftp, v, drhog(:,2), drhog(:,3) )
call invfft('Dense',v, dfftp )
call invfft('Rho',v, dfftp )
do ir=1,dfftp%nnr
d2rho(2,ir)=d2rho(2,ir)+real(v(ir))
d2rho(3,ir)=d2rho(3,ir)+aimag(v(ir))
@ -88,12 +88,12 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
drhog(ig,3) = -1.d0*tpiba**2*g(2,ig)*g(3,ig)*rhog(ig,iss)
enddo
CALL fftx_oned2threed(dfftp, v, drhog(:,1) )
CALL invfft('Dense',v, dfftp )
CALL invfft('Rho',v, dfftp )
do ir=1,dfftp%nnr
dxdyrho(ir)=dxdyrho(ir)+real(v(ir))
end do
CALL fftx_oned2threed(dfftp, v, drhog(:,2), drhog(:,3) )
call invfft('Dense',v, dfftp )
call invfft('Rho',v, dfftp )
do ir=1,dfftp%nnr
dxdzrho(ir)=dxdzrho(ir)+real(v(ir))
dydzrho(ir)=dydzrho(ir)+aimag(v(ir))

3
CPV/src/init.f90
View File

@ -112,6 +112,9 @@
CALL fft_type_init( dfftp, smap, "rho", gamma_only, lpara, intra_bgrp_comm, at, bg, gcutm, nyfft=nyfft_ )
!
END IF
! define the clock labels ( this enables the corresponding fft too ! )
dffts%rho_clock_label = 'ffts' ; dffts%wave_clock_label = 'fftw'
dfftp%rho_clock_label = 'fft'
!
!
CALL smallbox_grid_init( dfftp, dfftb )

2
CPV/src/nlcc.f90
View File

@ -144,7 +144,7 @@
wrk1(:) = rhoc(:)
call fwfft('Dense',wrk1, dfftp )
call fwfft('Rho',wrk1, dfftp )
!
! In g-space:
!

12
CPV/src/plugin_utilities.f90
View File

@ -66,7 +66,7 @@ SUBROUTINE v_h_of_rho_g( rhog, ehart, charge, v )
! ... transform hartree potential to real space
!
CALL fftx_oned2threed( dfftp, aux, aux1 )
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
!
! ... add hartree potential to the input potential
!
@ -132,7 +132,7 @@ SUBROUTINE v_h_of_rho_g( rhog, ehart, charge, v )
ALLOCATE( aux( dfftp%nnr ) )
DO is = 1, nspin
aux(:) = CMPLX(rhor( : , is ),0.D0,kind=dp)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
CALL fftx_threed2oned( dfftp, aux, rhog(:,is) )
END DO
!
@ -286,7 +286,7 @@ SUBROUTINE gradv_h_of_rho_r( rho, gradv )
!
rhoaux( : ) = CMPLX( rho( : ), 0.D0, KIND=dp )
!
CALL fwfft('Dense', rhoaux, dfftp)
CALL fwfft('Rho', rhoaux, dfftp)
CALL fftx_threed2oned( dfftp, rhoaux, rhog )
!
!
@ -303,7 +303,7 @@ SUBROUTINE gradv_h_of_rho_r( rho, gradv )
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL fftx_oned2threed( dfftp, rhoaux, gaux )
CALL invfft ('Dense', rhoaux, dfftp)
CALL invfft ('Rho', rhoaux, dfftp)
!
gradv(ipol,:) = REAL( rhoaux(:) )
!
@ -352,7 +352,7 @@ SUBROUTINE gradv_h_of_rho_r( rho, gradv )
ALLOCATE( dydzrho(dfftp%nnr) )
auxr(:) = CMPLX(a( : ),0.D0,kind=dp)
CALL fwfft ('Dense', auxr, dfftp)
CALL fwfft ('Rho', auxr, dfftp)
CALL fftx_threed2oned( dfftp, auxr, auxg )
! from G-space A compute R-space grad(A)
CALL gradrho(1,auxg,grada,d2rho,dxdyrho,dxdzrho,dydzrho)
@ -401,7 +401,7 @@ SUBROUTINE gradv_h_of_rho_r( rho, gradv )
ALLOCATE( dydzrho(dfftp%nnr) )
auxr(:) = CMPLX(a( : ),0.D0,kind=dp)
CALL fwfft ('Dense', auxr, dfftp)
CALL fwfft ('Rho', auxr, dfftp)
CALL fftx_threed2oned( dfftp, auxr, auxg )
!
! from G-space A compute R-space grad(A) and second derivatives

2
EPW/src/dvanqq2.f90
View File

@ -113,7 +113,7 @@
veff (ir, is) = CMPLX (v%of_r (ir, is), 0.d0, kind=DP)
ENDDO
ENDIF
CALL fwfft ('Dense', veff(:,is), dfftp)
CALL fwfft ('Rho', veff(:,is), dfftp)
ENDDO
!
! We compute here two of the three integrals needed in the phonon

6
EPW/src/dvqpsi_us3.f90
View File

@ -144,7 +144,7 @@
ENDIF
ENDIF
ENDDO
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
IF (.not.lsda) THEN
DO ir=1,dfftp%nnr
aux(ir) = aux(ir) * dmuxc(ir,1,1)
@ -158,7 +158,7 @@
(dmuxc(ir,is,1)+dmuxc(ir,is,2))
ENDDO
ENDIF
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
IF (doublegrid) THEN
auxs(:) = (0.d0, 0.d0)
DO ig=1,ngms
@ -170,7 +170,7 @@
!
! Now we compute dV_loc/dtau in real space
!
CALL invfft ('Smooth', aux1, dffts)
CALL invfft ('Rho', aux1, dffts)
DO ibnd = lower_band, upper_band
DO ip = 1, npol
aux2(:) = (0.d0, 0.d0)

173
FFTXlib/fft_fwinv.f90
View File

@ -6,6 +6,174 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#define NEW_FFT_INTERFACE
#if defined( NEW_FFT_INTERFACE )
!=---------------------------------------------------------------------------=!
SUBROUTINE invfft_y( grid_type, f, dfft, howmany )
!! Compute G-space to R-space for a specific grid type
!!
!! **grid_type = 'Rho'** :
!! inverse fourier transform of potentials and charge density f
!! On output, f is overwritten
!!
!! **grid_type = 'Wave'** :
!! inverse fourier transform of wave functions f
!! On output, f is overwritten
!!
!! **grid_type = 'tgWave'** :
!! inverse fourier transform of wave functions f with task group
!! On output, f is overwritten
!!
!! **dfft = FFT descriptor**, IMPORTANT NOTICE: grid is specified only by dfft.
!! No check is performed on the correspondence between dfft and grid_type.
!! from all other cases
USE fft_scalar, ONLY: cfft3d, cfft3ds
USE fft_smallbox, ONLY: cft_b, cft_b_omp
USE fft_parallel, ONLY: tg_cft3s
USE fft_types, ONLY: fft_type_descriptor
USE fft_param, ONLY: DP
IMPLICIT NONE
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
CHARACTER(LEN=*), INTENT(IN) :: grid_type
COMPLEX(DP) :: f(:)
INTEGER, OPTIONAL, INTENT(IN) :: howmany
INTEGER :: howmany_ = 1
CHARACTER(LEN=12) :: clock_label
IF(PRESENT(howmany) ) THEN
howmany_ = howmany
END IF
!
IF( grid_type == 'Rho' ) THEN
clock_label = dfft%rho_clock_label
ELSE IF( grid_type == 'Wave' .OR. grid_type == 'tgWave' ) THEN
clock_label = dfft%wave_clock_label
ELSE
CALL fftx_error__( ' invfft ', ' unknown grid: '//grid_type , 1 )
END IF
IF (clock_label == ' ') CALL fftx_error__( ' invfft ', ' uninitialized fft type : '//grid_type , 1 )
CALL start_clock(clock_label)
IF( dfft%lpara ) THEN
IF( howmany_ /= 1 ) THEN
CALL fftx_error__( ' invfft ', ' howmany not yet implemented for parallel driver ', 1 )
END IF
IF( grid_type == 'Rho' ) THEN
CALL tg_cft3s( f, dfft, 1 )
ELSE IF( grid_type == 'Wave' ) THEN
CALL tg_cft3s( f, dfft, 2 )
ELSE IF( grid_type == 'tgWave' ) THEN
CALL tg_cft3s( f, dfft, 3 )
END IF
ELSE
IF( grid_type == 'Rho' ) THEN
CALL cfft3d( f, dfft%nr1, dfft%nr2, dfft%nr3, &
dfft%nr1x, dfft%nr2x, dfft%nr3x, howmany_ , 1)
ELSE
CALL cfft3ds( f, dfft%nr1, dfft%nr2, dfft%nr3, &
dfft%nr1x,dfft%nr2x,dfft%nr3x, howmany_ , 1, &
dfft%isind, dfft%iplw )
END IF
END IF
CALL stop_clock( clock_label )
RETURN
END SUBROUTINE invfft_y
!
!=---------------------------------------------------------------------------=!
!
SUBROUTINE fwfft_y( grid_type, f, dfft, howmany )
!! Compute R-space to G-space for a specific grid type
!!
!! **grid_type = 'Rho'**
!! forward fourier transform of potentials and charge density f
!! On output, f is overwritten
!!
!! **grid_type = 'Wave'**
!! forward fourier transform of wave functions f
!! On output, f is overwritten
!!
!! **grid_type = 'tgWave'**
!! forward fourier transform of wave functions f with task group
!! On output, f is overwritten
!!
USE fft_scalar, ONLY: cfft3d, cfft3ds
USE fft_parallel, ONLY: tg_cft3s
USE fft_types, ONLY: fft_type_descriptor
USE fft_param, ONLY: DP
IMPLICIT NONE
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
CHARACTER(LEN=*), INTENT(IN) :: grid_type
COMPLEX(DP) :: f(:)
INTEGER, OPTIONAL, INTENT(IN) :: howmany
INTEGER :: howmany_ = 1
CHARACTER(LEN=12) :: clock_label
IF(PRESENT(howmany) ) THEN
howmany_ = howmany
END IF
IF( grid_type == 'Rho' ) THEN
clock_label = dfft%rho_clock_label
ELSE IF( grid_type == 'Wave' .OR. grid_type == 'tgWave' ) THEN
clock_label = dfft%wave_clock_label
ELSE
CALL fftx_error__( ' fwfft ', ' unknown grid: '//grid_type , 1 )
END IF
IF (clock_label == ' ') CALL fftx_error__( ' fwfft ', ' uninitialized fft type : '//grid_type , 1 )
CALL start_clock(clock_label)
IF( dfft%lpara ) THEN
IF( howmany_ /= 1 ) THEN
CALL fftx_error__( ' fwfft ', ' howmany not yet implemented for parallel driver ', 1 )
END IF
IF( grid_type == 'Rho' ) THEN
CALL tg_cft3s(f,dfft,-1)
ELSE IF( grid_type == 'Wave' ) THEN
CALL tg_cft3s(f,dfft,-2 )
ELSE IF( grid_type == 'tgWave' ) THEN
CALL tg_cft3s(f,dfft,-3 )
END IF
ELSE
IF( grid_type == 'Rho' ) THEN
CALL cfft3d( f, dfft%nr1, dfft%nr2, dfft%nr3, &
dfft%nr1x,dfft%nr2x,dfft%nr3x, howmany_ , -1)
ELSE
CALL cfft3ds( f, dfft%nr1, dfft%nr2, dfft%nr3, &
dfft%nr1x,dfft%nr2x,dfft%nr3x, howmany_ , -1, &
dfft%isind, dfft%iplw )
END IF
END IF
CALL stop_clock( clock_label )
RETURN
!
END SUBROUTINE fwfft_y
!=---------------------------------------------------------------------------=!
#else
!=---------------------------------------------------------------------------=!
SUBROUTINE invfft_x( grid_type, f, dfft, howmany )
!! Compute G-space to R-space for a specific grid type
@ -115,7 +283,6 @@ SUBROUTINE invfft_x( grid_type, f, dfft, howmany )
RETURN
END SUBROUTINE invfft_x
!=---------------------------------------------------------------------------=!
!
!=---------------------------------------------------------------------------=!
SUBROUTINE fwfft_x( grid_type, f, dfft, howmany )
@ -225,7 +392,9 @@ SUBROUTINE fwfft_x( grid_type, f, dfft, howmany )
RETURN
!
END SUBROUTINE fwfft_x
!=---------------------------------------------------------------------------=!
#endif
!
!=---------------------------------------------------------------------------=!
SUBROUTINE invfft_b( f, dfft, ia )

25
FFTXlib/fft_helper_subroutines.f90
View File

@ -303,6 +303,31 @@ CONTAINS
END IF
END SUBROUTINE
SUBROUTINE c2psi_k( desc, psi, c, igk, ngk)
!
! Copy wave-functions from 1D array (c/evc) ordered according (k+G) index igk
! to 3D array (psi) in Fourier space
!
USE fft_param
USE fft_types, ONLY : fft_type_descriptor
TYPE(fft_type_descriptor), INTENT(in) :: desc
complex(DP), INTENT(OUT) :: psi(:)
complex(DP), INTENT(IN) :: c(:)
INTEGER, INTENT(IN) :: igk(:), ngk
! local variables
integer :: ig
!
! nl array: hold conversion indices form 3D to 1-D vectors.
! Columns along the z-direction are stored contigiously
! c array: stores the Fourier expansion coefficients of the wave function
! Loop for all local g-vectors (npw
psi = 0.0d0
do ig = 1, ngk
psi( desc%nl( igk( ig ) ) ) = c( ig )
end do
!
END SUBROUTINE
SUBROUTINE fftx_oned2threed( desc, psi, c, ca )
!
! Copy charge density from 1D array (c) to 3D array (psi) in Fourier

8
FFTXlib/fft_interfaces.f90
View File

@ -21,7 +21,7 @@ MODULE fft_interfaces
!! and to the "box-grid" version **invfft_b**, used only in CP
!! (the latter has an additional argument)
SUBROUTINE invfft_x( grid_type, f, dfft, howmany )
SUBROUTINE invfft_y( grid_type, f, dfft, howmany )
USE fft_types, ONLY: fft_type_descriptor
USE fft_param, ONLY :DP
IMPLICIT NONE
@ -29,7 +29,7 @@ MODULE fft_interfaces
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
INTEGER, OPTIONAL, INTENT(IN) :: howmany
COMPLEX(DP) :: f(:)
END SUBROUTINE invfft_x
END SUBROUTINE invfft_y
!
SUBROUTINE invfft_b( f, dfft, ia )
USE fft_smallbox_type, ONLY: fft_box_descriptor
@ -42,7 +42,7 @@ MODULE fft_interfaces
END INTERFACE
INTERFACE fwfft
SUBROUTINE fwfft_x( grid_type, f, dfft, howmany )
SUBROUTINE fwfft_y( grid_type, f, dfft, howmany )
USE fft_types, ONLY: fft_type_descriptor
USE fft_param, ONLY :DP
IMPLICIT NONE
@ -50,7 +50,7 @@ MODULE fft_interfaces
TYPE(fft_type_descriptor), INTENT(IN) :: dfft
INTEGER, OPTIONAL, INTENT(IN) :: howmany
COMPLEX(DP) :: f(:)
END SUBROUTINE fwfft_x
END SUBROUTINE fwfft_y
END INTERFACE
END MODULE fft_interfaces

3
FFTXlib/fft_types.f90
View File

@ -122,6 +122,9 @@ MODULE fft_types
INTEGER, ALLOCATABLE :: tg_rdsp(:)! receive displacement for task group A2A communicattion
!
LOGICAL :: have_task_groups = .FALSE.
!
CHARACTER(len=12):: rho_clock_label = ' '
CHARACTER(len=12):: wave_clock_label = ' '
END TYPE

2
FFTXlib/test.f90
View File

@ -266,7 +266,9 @@ program test
dffts%have_task_groups = (ntgs > 1)
use_tg = dffts%have_task_groups
!
dffts%rho_clock_label='ffts' ; dffts%wave_clock_label='fftw'
CALL fft_type_init(dffts, smap, "wave", gamma_only, .true., comm, at, bg, gkcut, gcutms/gkcut, nyfft=ntgs)
dfftp%rho_clock_label='fft'
CALL fft_type_init(dfftp, smap, "rho", gamma_only, .true., comm, at, bg, gcutm, 4.d0, nyfft=ntgs)
!
if (mype == 0) then

4
FFTXlib/test0.f90
View File

@ -255,7 +255,7 @@ program test
CALL MPI_BARRIER( MPI_COMM_WORLD, ierr)
#endif
call invfft ('Dense',aux,dffts)
call invfft ('Rho',aux,dffts)
if( mype == 0 ) write (*,*) 'function in Real space (i,j,k)'
do k =1, 5
@ -268,7 +268,7 @@ program test
end do
end do
call fwfft ('Dense',aux,dffts)
call fwfft ('Rho',aux,dffts)
if( mype == 0 ) write (*,*) 'function in Reciprocal space '
do k =1, 5

2
GWW/head/solve_head.f90
View File

@ -474,7 +474,7 @@ subroutine solve_head
#endif
do ipol=1,3
CALL fwfft ('Dense', pola_charge(1:dfftp%nnr,1,ipol,i), dfftp)
CALL fwfft ('Rho', pola_charge(1:dfftp%nnr,1,ipol,i), dfftp)
tmp_g(:)=(0.d0,0.d0)
tmp_g(gstart:ngm)=pola_charge(dfftp%nl(gstart:ngm),1,ipol,i)

6
GWW/pw4gww/dft_exchange.f90
View File

@ -201,7 +201,7 @@ subroutine dft_exchange(nbnd_v,nbnd_s,n_set, e_x,ks_wfcs)
CALL invfft ('Wave', psic, dffts)
prod_c(1:dfftp%nnr)=dcmplx(dble(psic(1:dfftp%nnr))*tmpreal_v(1:dfftp%nnr,iv-(iiv-1)*n_set)&
& ,0.d0)
CALL fwfft ('Dense', prod_c, dfftp)
CALL fwfft ('Rho', prod_c, dfftp)
prod_g2(1:ngm,ks)=prod_c(dfftp%nl(1:ngm))
enddo
!NOT_TO_BE_INCLUDED_END
@ -214,7 +214,7 @@ subroutine dft_exchange(nbnd_v,nbnd_s,n_set, e_x,ks_wfcs)
! (iv,js, prod_r(:),1,becpr(:,iv),becpr(:,js))
prod_c(:)=dcmplx(prod_r(:),0.d0)
CALL fwfft ('Dense', prod_c, dfftp)
CALL fwfft ('Rho', prod_c, dfftp)
!go to g_space
prod_g(1:ngm)=prod_c(dfftp%nl(1:ngm))
!calculated exchange
@ -443,7 +443,7 @@ subroutine addus_charge(r_ij,becp_iw,becp_jw)
psic(:) = (0.d0, 0.d0)
psic( dfftp%nl(:) ) = aux(:,is)
if (gamma_only) psic( dfftp%nlm(:) ) = CONJG(aux(:,is))
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
r_ij(:)=r_ij(:)+psic(:)
enddo
deallocate (aux)

3
GWW/pw4gww/fft_custom.f90
View File

@ -219,6 +219,8 @@ CONTAINS
CALL calculate_gkcut()
CALL fft_type_init( fc%dfftt, fc%smapt, "rho", .not. tk, .true., intra_pool_comm, fc%at_t, fc%bg_t, fc%gcutmt,fc%dual_t, &
nyfft=nyfft)
! define the clock labels ( this enables the corresponding fft too ! )
fc%dfftt%rho_clock_label = 'fftc' ; fc%dfftt%wave_clock_label = 'fftcw'
!CALL fft_type_init( fc%dfftt, fc%smapt, "rho", .not. tk, .true., intra_pool_comm, fc%at_t, fc%bg_t, fc%gcutmt/gkcut )
!
! set the values of fft arrays
@ -276,6 +278,7 @@ CONTAINS
CALL fft_type_init( fc%dfftt, fc%smapt, "rho", .not. tk, .false., intra_pool_comm, fc%at_t, fc%bg_t, fc%gcutmt/gkcut, &
nyfft=nyfft )
fc%dfftt%rho_clock_label = 'fftc' ; fc%dfftt%wave_clock_label = 'fftcw'
fc%nrx1t = fc%dfftt%nr1x
fc%nrx2t = fc%dfftt%nr2x

4
GWW/pw4gww/pola_lanczos.f90
View File

@ -123,7 +123,7 @@ subroutine pola_basis_lanczos(n_set,nstates,numpw, nsteps,ispin)
psic(dfftp%nl(ig))=tmp_g(ig)
psic(dfftp%nlm(ig))=CONJG(tmp_g(ig))
enddo
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
tmp_r(:)=dble(psic(:))
call davcio(tmp_r,dfftp%nnr,iunrprod,iw,1)
enddo
@ -1545,7 +1545,7 @@ subroutine global_pola_lanczos(nstates,nstates_eff,threshold,nglobal,nsteps,nump
psic(dfftp%nl(ig))=tmp_g(ig)
psic(dfftp%nlm(ig))=CONJG(tmp_g(ig))
enddo
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
tmp_r(:)=dble(psic(:))
!!form products with w_v and trasfrom in G space
psic(:)=cmplx(tmp_r(:)*wv_real(:),0.d0)

4
GWW/pw4gww/self_lanczos.f90
View File

@ -188,7 +188,7 @@ subroutine self_basis_lanczos(n_set,nstates,numpw, nsteps,ispin,lfull,nfull)
psic(dfftp%nl(ig))=tmp_g(ig)*fac(ig)
psic(dfftp%nlm(ig))=CONJG(tmp_g(ig))*fac(ig)
enddo
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
tmp_r(:)=dble(psic(:))
call davcio(tmp_r,dfftp%nnr,iunrprod,iw,1)
enddo
@ -1110,7 +1110,7 @@ endif
psic(dfftp%nl(ig))=tmp_g(ig)*fac(ig)
psic(dfftp%nlm(ig))=CONJG(tmp_g(ig))*fac(ig)
enddo
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
tmp_r(:)=dble(psic(:))
!!form products with w_v and trasfrom in G space
psic(:)=cmplx(tmp_r(:)*wv_real(:),0.d0)

2
GWW/pw4gww/semicore.f90
View File

@ -104,7 +104,7 @@
endif
!fft back
CALL fwfft ('Dense', prod, dfftp)
CALL fwfft ('Rho', prod, dfftp)
if(iv==n_semicore) then
prod_g(1:npw,1)=prod(dfftp%nl(1:npw))
if(gstart==2) then

2
GWW/pw4gww/semicore_read.f90
View File

@ -237,7 +237,7 @@
psic(dfftp%nl(ig))=tmp_g(ig)*fac(ig)
psic(dfftp%nlm(ig))=CONJG(tmp_g(ig))*fac(ig)
enddo
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
tmp_r(1:dfftp%nnr)=dble(psic(1:dfftp%nnr))
do ii=1,num_nbnds

8
LR_Modules/dgradcorr.f90
View File

@ -265,7 +265,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
! bring a(r) to G-space, a(G) ...
aux (:) = a(:)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
! multiply by i(q+G) to get (\grad_ipol a)(q+G) ...
do ipol = 1, 3
gaux (:) = (0.d0, 0.d0)
@ -275,7 +275,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
enddo
! bring back to R-space, (\grad_ipol a)(r) ...
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
! ...and add the factor 2\pi/a missing in the definition of q+G
do n = 1, nrxx
ga (ipol, n) = gaux (n) * tpiba
@ -318,7 +318,7 @@ subroutine qgrad_dot (xq, nrxx, a, ngm, g, nl, alat, da)
aux (n) = a (ipol, n)
enddo
! bring a(ipol,r) to G-space, a(G) ...
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
! multiply by i(q+G) to get (\grad_ipol a)(q+G) ...
do n = 1, ngm
da (nl(n)) = da (nl(n)) + &
@ -336,7 +336,7 @@ subroutine qgrad_dot (xq, nrxx, a, ngm, g, nl, alat, da)
end if
! bring back to R-space, (\grad_ipol a)(r) ...
CALL invfft ('Dense', da, dfftp)
CALL invfft ('Rho', da, dfftp)
! ...add the factor 2\pi/a missing in the definition of q+G and sum
da (:) = da (:) * tpiba
deallocate (aux)

10
LR_Modules/dv_of_drho.f90
View File

@ -119,7 +119,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
dvscf(:,1) = dvscf(:,1) + dvscf(:,2)
end if
!
CALL fwfft ('Dense', dvscf(:,1), dfftp)
CALL fwfft ('Rho', dvscf(:,1), dfftp)
!
! 2) Hartree contribution is computed in reciprocal space
!
@ -162,7 +162,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
!
! Transform response Hartree potential to real space
!
CALL invfft ('Dense', dvhart (:,is), dfftp)
CALL invfft ('Rho', dvhart (:,is), dfftp)
!
enddo
!
@ -195,7 +195,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
!
! Transformed back to real space
!
CALL invfft ('Dense', dvhart (:, is), dfftp)
CALL invfft ('Rho', dvhart (:, is), dfftp)
!
enddo
!
@ -210,7 +210,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
! General k points implementation
!
do is = 1, nspin_lsda
CALL fwfft ('Dense', dvaux (:, is), dfftp)
CALL fwfft ('Rho', dvaux (:, is), dfftp)
IF (do_cutoff_2D) THEN
call cutoff_dv_of_drho(dvaux, is, dvscf)
ELSE
@ -225,7 +225,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
!
! Transformed back to real space
!
CALL invfft ('Dense', dvaux (:, is), dfftp)
CALL invfft ('Rho', dvaux (:, is), dfftp)
!
enddo
!

16
LR_Modules/dv_rVV10.f90
View File

@ -301,14 +301,14 @@ subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
do icar = 1,3
delta_h(:) = (h1t(:) * gradient_rho(:,icar)+ h2t(:) * gradient_drho(:,icar))
CALL fwfft ('Dense', delta_h, dfftp)
CALL fwfft ('Rho', delta_h, dfftp)
delta_h_aux(:) = (0.0_DP, 0.0_DP)
delta_h_aux(dfftp%nl(:)) = CMPLX(0.0_DP,(g(icar,:)+q_point(icar)),kind=DP ) * delta_h(dfftp%nl(:))
if (gamma_only) delta_h_aux(dfftp%nlm(:)) = CONJG(delta_h_aux(dfftp%nl(:)))
CALL invfft ('Dense', delta_h_aux, dfftp)
CALL invfft ('Rho', delta_h_aux, dfftp)
delta_h_aux(:) = delta_h_aux(:)*tpiba
@ -637,8 +637,8 @@ subroutine get_u_delta_u(u, delta_u, q_point)
!!
call start_clock( 'vdW_ffts')
do q1_i = 1, Nqs
CALL fwfft ('Dense', u(:,q1_i), dfftp)
CALL fwfft ('Dense', delta_u(:,q1_i), dfftp)
CALL fwfft ('Rho', u(:,q1_i), dfftp)
CALL fwfft ('Rho', delta_u(:,q1_i), dfftp)
end do
call stop_clock( 'vdW_ffts')
@ -683,8 +683,8 @@ subroutine get_u_delta_u(u, delta_u, q_point)
!!
call start_clock( 'vdW_ffts')
do q1_i = 1, Nqs
CALL invfft ('Dense', temp_u(:,q1_i), dfftp)
CALL invfft ('Dense', temp_delta_u(:,q1_i), dfftp)
CALL invfft ('Rho', temp_u(:,q1_i), dfftp)
CALL invfft ('Rho', temp_delta_u(:,q1_i), dfftp)
end do
call stop_clock( 'vdW_ffts')
@ -728,7 +728,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
! bring a(r) to G-space, a(G) ...
aux (:) = a(:)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
! multiply by i(q+G) to get (\grad_ipol a)(q+G) ...
do ipol = 1, 3
gaux (:) = (0.d0, 0.d0)
@ -738,7 +738,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
enddo
! bring back to R-space, (\grad_ipol a)(r) ...
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
! ...and add the factor 2\pi/a missing in the definition of q+G
do n = 1, nrxx
ga (n, ipol) = gaux (n) * tpiba

16
LR_Modules/dv_vdW_DF.f90
View File

@ -299,14 +299,14 @@ subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
do icar = 1,3
delta_h(:) = (h1t(:) * gradient_rho(:,icar)+ h2t(:) * gradient_drho(:,icar))
CALL fwfft ('Dense', delta_h, dfftp)
CALL fwfft ('Rho', delta_h, dfftp)
delta_h_aux(:) = (0.0_DP, 0.0_DP)
delta_h_aux(dfftp%nl(:)) = CMPLX(0.0_DP,(g(icar,:)+q_point(icar)),kind=DP ) * delta_h(dfftp%nl(:))
if (gamma_only) delta_h_aux(dfftp%nlm(:)) = CONJG(delta_h_aux(dfftp%nl(:)))
CALL invfft ('Dense', delta_h_aux, dfftp)
CALL invfft ('Rho', delta_h_aux, dfftp)
delta_h_aux(:) = delta_h_aux(:)*tpiba
@ -611,8 +611,8 @@ subroutine get_u_delta_u(u, delta_u, q_point)
!!
call start_clock( 'vdW_ffts')
do q1_i = 1, Nqs
CALL fwfft ('Dense', u(:,q1_i), dfftp)
CALL fwfft ('Dense', delta_u(:,q1_i), dfftp)
CALL fwfft ('Rho', u(:,q1_i), dfftp)
CALL fwfft ('Rho', delta_u(:,q1_i), dfftp)
end do
call stop_clock( 'vdW_ffts')
@ -658,8 +658,8 @@ subroutine get_u_delta_u(u, delta_u, q_point)
!!
call start_clock( 'vdW_ffts')
do q1_i = 1, Nqs
CALL invfft ('Dense', temp_u(:,q1_i), dfftp)
CALL invfft ('Dense', temp_delta_u(:,q1_i), dfftp)
CALL invfft ('Rho', temp_u(:,q1_i), dfftp)
CALL invfft ('Rho', temp_delta_u(:,q1_i), dfftp)
end do
call stop_clock( 'vdW_ffts')
@ -703,7 +703,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
! bring a(r) to G-space, a(G) ...
aux (:) = a(:)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
! multiply by i(q+G) to get (\grad_ipol a)(q+G) ...
do ipol = 1, 3
gaux (:) = (0.d0, 0.d0)
@ -713,7 +713,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
enddo
! bring back to R-space, (\grad_ipol a)(r) ...
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
! ...and add the factor 2\pi/a missing in the definition of q+G
do n = 1, nrxx
ga (n, ipol) = gaux (n) * tpiba

2
LR_Modules/newdq.f90
View File

@ -97,7 +97,7 @@ subroutine newdq (dvscf, npe)
do ir = 1, dfftp%nnr
veff (ir) = dvscf (ir, is, ipert)
enddo
CALL fwfft ('Dense', veff, dfftp)
CALL fwfft ('Rho', veff, dfftp)
do ig = 1, ngm
aux2 (ig, is) = veff (dfftp%nl (ig) )
enddo

2
LR_Modules/setup_dgc.f90
View File

@ -75,7 +75,7 @@ subroutine setup_dgc
psic(:) = rhoout(:,is)
!
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
rhogout(:,is) = psic(dfftp%nl(:))
!

26
Modules/fft_rho.f90
View File

@ -52,7 +52,7 @@ CONTAINS
psi(ir)=CMPLX(rhor(ir,iss),0.0_dp,kind=dp)
END DO
END IF
CALL fwfft('Dense', psi, dfftp )
CALL fwfft('Rho', psi, dfftp )
CALL fftx_threed2oned( dfftp, psi, rhog(:,iss) )
ELSE
isup=1
@ -66,7 +66,7 @@ CONTAINS
psi(ir)=CMPLX(rhor(ir,isup),rhor(ir,isdw),kind=dp)
END DO
END IF
CALL fwfft('Dense', psi, dfftp )
CALL fwfft('Rho', psi, dfftp )
CALL fftx_threed2oned( dfftp, psi, rhog(:,isup), rhog(:,isdw) )
ENDIF
@ -101,7 +101,7 @@ CONTAINS
psi(ir)=CMPLX(rhor(ir,iss),0.0_dp,kind=dp)
END DO
END IF
CALL fwfft('Smooth', psi, dffts )
CALL fwfft('Rho', psi, dffts )
CALL fftx_threed2oned( dffts, psi, rhog(:,iss) )
ELSE
isup=1
@ -115,7 +115,7 @@ CONTAINS
psi(ir)=CMPLX(rhor(ir,isup),rhor(ir,isdw),kind=dp)
END DO
END IF
CALL fwfft('Smooth', psi, dffts )
CALL fwfft('Rho', psi, dffts )
CALL fftx_threed2oned( dffts, psi, rhog(:,isup), rhog(:,isdw) )
ENDIF
@ -142,7 +142,7 @@ CONTAINS
IF( nspin == 1 ) THEN
iss=1
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Dense',psi, dfftp )
CALL invfft('Rho',psi, dfftp )
!$omp parallel do
DO ir=1,dfftp%nnr
rhor(ir,iss)=DBLE(psi(ir))
@ -152,7 +152,7 @@ CONTAINS
isup=1
isdw=2
CALL fftx_oned2threed( dfftp, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Dense',psi, dfftp )
CALL invfft('Rho',psi, dfftp )
!$omp parallel do
DO ir=1,dfftp%nnr
rhor(ir,isup)= DBLE(psi(ir))
@ -165,7 +165,7 @@ CONTAINS
!
DO iss=1, nspin
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Dense',psi, dfftp )
CALL invfft('Rho',psi, dfftp )
!$omp parallel do
DO ir=1,dfftp%nnr
rhor(ir,iss)=DBLE(psi(ir))
@ -197,7 +197,7 @@ CONTAINS
IF( nspin == 1 ) THEN
iss=1
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Dense',psi, dfftp )
CALL invfft('Rho',psi, dfftp )
!$omp parallel do
DO ir=1,dfftp%nnr
rhor(ir)=DBLE(psi(ir))
@ -207,7 +207,7 @@ CONTAINS
isup=1
isdw=2
CALL fftx_oned2threed( dfftp, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Dense',psi, dfftp )
CALL invfft('Rho',psi, dfftp )
!$omp parallel do
DO ir=1,dfftp%nnr
rhor(ir)= DBLE(psi(ir))+AIMAG(psi(ir))
@ -219,7 +219,7 @@ CONTAINS
!
DO iss=1, nspin
CALL fftx_oned2threed( dfftp, psi, rhog(:,iss) )
CALL invfft('Dense',psi, dfftp )
CALL invfft('Rho',psi, dfftp )
IF( iss == 1 ) THEN
!$omp parallel do
DO ir=1,dfftp%nnr
@ -259,7 +259,7 @@ CONTAINS
IF( nspin == 1 ) THEN
iss=1
CALL fftx_oned2threed( dffts, psi, rhog(:,iss) )
CALL invfft('Smooth',psi, dffts )
CALL invfft('Rho',psi, dffts )
!$omp parallel do
DO ir=1,dffts%nnr
rhor(ir,iss)=DBLE(psi(ir))
@ -269,7 +269,7 @@ CONTAINS
isup=1
isdw=2
CALL fftx_oned2threed( dffts, psi, rhog(:,isup), rhog(:,isdw) )
CALL invfft('Smooth',psi, dffts )
CALL invfft('Rho',psi, dffts )
!$omp parallel do
DO ir=1,dffts%nnr
rhor(ir,isup)= DBLE(psi(ir))
@ -282,7 +282,7 @@ CONTAINS
!
DO iss=1, nspin
CALL fftx_oned2threed( dffts, psi, rhog(:,iss) )
CALL invfft('Smooth',psi, dffts )
CALL invfft('Rho',psi, dffts )
!$omp parallel do
DO ir=1,dffts%nnr
rhor(ir,iss)=DBLE(psi(ir))

14
Modules/xc_rVV10.f90
View File

@ -176,7 +176,7 @@ CONTAINS
call start_clock( 'rVV10_ffts')
do theta_i = 1, Nqs
CALL invfft('Dense', thetas(:,theta_i), dfftp)
CALL invfft('Rho', thetas(:,theta_i), dfftp)
end do
call stop_clock( 'rVV10_ffts')
@ -391,7 +391,7 @@ CONTAINS
call start_clock( 'rVV10_ffts')
do theta_i = 1, Nqs
CALL invfft('Dense', u_vdW(:,theta_i), dfftp)
CALL invfft('Rho', u_vdW(:,theta_i), dfftp)
end do
call stop_clock( 'rVV10_ffts')
@ -682,7 +682,7 @@ CONTAINS
do theta_i = 1, Nqs
CALL fwfft ('Dense', thetas(:,theta_i), dfftp)
CALL fwfft ('Rho', thetas(:,theta_i), dfftp)
end do
call stop_clock( 'rVV10_ffts')
@ -1044,7 +1044,7 @@ subroutine numerical_gradient(total_rho, gradient_rho)
! rho in G space
allocate ( c_rho(dfftp%nnr), c_grho(dfftp%nnr) )
c_rho(1:dfftp%nnr) = CMPLX(total_rho(1:dfftp%nnr),0.0_DP)
CALL fwfft ('Dense', c_rho, dfftp)
CALL fwfft ('Rho', c_rho, dfftp)
do icar=1,3
! compute gradient in G space
@ -1053,7 +1053,7 @@ subroutine numerical_gradient(total_rho, gradient_rho)
if (gamma_only) c_grho( dfftp%nlm(:) ) = CONJG( c_grho( dfftp%nl(:) ) )
! back in real space
CALL invfft ('Dense', c_grho, dfftp)
CALL invfft ('Rho', c_grho, dfftp)
gradient_rho(:,icar) = REAL( c_grho(:) )
end do
deallocate ( c_rho, c_grho )
@ -1312,10 +1312,10 @@ end subroutine vdW_energy
do icar = 1,3
h(:) = CMPLX(h_prefactor(:) * gradient_rho(:,icar),0.0_DP)
CALL fwfft ('Dense', h, dfftp)
CALL fwfft ('Rho', h, dfftp)
h(dfftp%nl(:)) = CMPLX(0.0_DP,1.0_DP) * tpiba * g(icar,:) * h(dfftp%nl(:))
if (gamma_only) h(dfftp%nlm(:)) = CONJG(h(dfftp%nl(:)))
CALL invfft ('Dense', h, dfftp)
CALL invfft ('Rho', h, dfftp)
potential(:) = potential(:) - REAL(h(:))
end do

18
Modules/xc_vdW_DF.f90
View File

@ -336,7 +336,7 @@ CONTAINS
! FFTing the u_i(k) to get the u_i(r) of SOLER equation 11.
do theta_i = 1, Nqs
CALL invfft('Dense', thetas(:,theta_i), dfftp)
CALL invfft('Rho', thetas(:,theta_i), dfftp)
end do
call get_potential (q0, dq0_drho, dq0_dgradrho, grad_rho, thetas, potential)
@ -535,7 +535,7 @@ CONTAINS
! FFTing the u_i(k) to get the u_i(r) of SOLER equation 11.
do theta_i = 1, Nqs
CALL invfft('Dense', thetas(:,theta_i), dfftp)
CALL invfft('Rho', thetas(:,theta_i), dfftp)
end do
call get_potential (q0, dq0_drho_up , dq0_dgradrho_up , grad_rho_up , thetas, potential_up )
@ -702,7 +702,7 @@ CONTAINS
end do
do idx = 1, Nqs
CALL fwfft ('Dense', thetas(:,idx), dfftp)
CALL fwfft ('Rho', thetas(:,idx), dfftp)
end do
END SUBROUTINE get_q0_on_grid
@ -900,7 +900,7 @@ CONTAINS
end do
do idx = 1, Nqs
CALL fwfft ('Dense', thetas(:,idx), dfftp)
CALL fwfft ('Rho', thetas(:,idx), dfftp)
end do
END SUBROUTINE get_q0_on_grid_spin
@ -1219,10 +1219,10 @@ CONTAINS
if ( gradient2 > 0.0D0 ) h(i_grid) = h(i_grid) / SQRT( gradient2 )
end do
CALL fwfft ('Dense', h, dfftp)
CALL fwfft ('Rho', h, dfftp)
h(dfftp%nl(:)) = CMPLX(0.0_DP,1.0_DP) * tpiba * g(icar,:) * h(dfftp%nl(:))
if (gamma_only) h(dfftp%nlm(:)) = CONJG(h(dfftp%nl(:)))
CALL invfft ('Dense', h, dfftp)
CALL invfft ('Rho', h, dfftp)
potential(:) = potential(:) - REAL(h(:))
end do
@ -1701,7 +1701,7 @@ CONTAINS
! Get u in real space.
do theta_i = 1, Nqs
CALL invfft('Dense', u_vdW(:,theta_i), dfftp)
CALL invfft('Rho', u_vdW(:,theta_i), dfftp)
end do
@ -1960,7 +1960,7 @@ CONTAINS
allocate ( c_rho(dfftp%nnr), c_grho(dfftp%nnr) )
c_rho(1:dfftp%nnr) = CMPLX(total_rho(1:dfftp%nnr),0.0_DP)
CALL fwfft ('Dense', c_rho, dfftp)
CALL fwfft ('Rho', c_rho, dfftp)
do icar=1,3
@ -1975,7 +1975,7 @@ CONTAINS
! -----------------------------------------------------------------
! Back in real space.
CALL invfft ('Dense', c_grho, dfftp)
CALL invfft ('Rho', c_grho, dfftp)
grad_rho(:,icar) = REAL( c_grho(:) )
end do

4
PHonon/Gamma/a_h.f90
View File

@ -101,7 +101,7 @@ SUBROUTINE A_h(npw,e,h,ah)
DO j = 1,dfftp%nnr
drhoc(j) = cmplx(drho(j),0.d0,kind=DP)
ENDDO
CALL fwfft ('Dense', drhoc, dfftp)
CALL fwfft ('Rho', drhoc, dfftp)
!
! drho is deltarho(r), drhoc is deltarho(g)
!
@ -131,7 +131,7 @@ SUBROUTINE A_h(npw,e,h,ah)
drhoc(dfftp%nl (j)) = e2*fpi*drhoc(dfftp%nl(j))/ (tpiba2*gg(j))
drhoc(dfftp%nlm(j)) = conjg(drhoc(dfftp%nl (j)))
ENDDO
CALL invfft ('Dense', drhoc, dfftp)
CALL invfft ('Rho', drhoc, dfftp)
!
! drhoc now contains deltaV_hartree
!

10
PHonon/Gamma/dgradcorr.f90
View File

@ -183,7 +183,7 @@ SUBROUTINE gradient1( nrxx, a, ngm, g, nl, nlm, alat, ga)
ENDDO
! bring back to R-space, (\grad_ipol a)(r) ...
CALL invfft ('Dense', gaux, dfftp )
CALL invfft ('Rho', gaux, dfftp )
! ...and add the factor 2\pi/a missing in the definition of q+G
DO n = 1, nrxx
ga (ipol , n) = dble(gaux (n)) * tpiba
@ -199,7 +199,7 @@ SUBROUTINE gradient1( nrxx, a, ngm, g, nl, nlm, alat, ga)
gaux(nlm(n)) = conjg(gaux(nl(n)))
ENDDO
! bring back to R-space, (\grad_ipol a)(r) ...
CALL invfft ('Dense', gaux, dfftp )
CALL invfft ('Rho', gaux, dfftp )
! ...and add the factor 2\pi/a missing in the definition of q+G
DO n = 1, nrxx
ga (ipol, n) = dble(gaux (n)) * tpiba
@ -241,7 +241,7 @@ SUBROUTINE grad_dot1 ( nrxx, a, ngm, g, nl, nlm, alat, da)
aux (n) = cmplx( dble(a(ipol, n)), dble(a(ipol+1, n)),kind=DP)
ENDDO
! bring a(ipol,r) to G-space, a(G) ...
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
! multiply by i(q+G) to get (\grad_ipol a)(q+G) ...
DO n = 1, ngm
fp = (aux(nl (n)) + aux (nlm(n)))*0.5d0
@ -258,7 +258,7 @@ SUBROUTINE grad_dot1 ( nrxx, a, ngm, g, nl, nlm, alat, da)
aux (n) = a(ipol, n)
ENDDO
! bring a(ipol,r) to G-space, a(G) ...
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
! multiply by i(q+G) to get (\grad_ipol a)(q+G) ...
DO n = 1, ngm
da (nl(n)) = da (nl(n)) + cmplx(0.d0, g(ipol, n),kind=DP) * aux(nl(n))
@ -268,7 +268,7 @@ SUBROUTINE grad_dot1 ( nrxx, a, ngm, g, nl, nlm, alat, da)
da(nlm(n)) = conjg(da(nl(n)))
ENDDO
! bring back to R-space, (\grad_ipol a)(r) ...
CALL invfft ('Dense', da, dfftp )
CALL invfft ('Rho', da, dfftp )
! ...add the factor 2\pi/a missing in the definition of q+G and sum
DO n = 1, nrxx
da (n) = da (n) * tpiba

4
PHonon/Gamma/dvb_cc.f90
View File

@ -31,11 +31,11 @@ SUBROUTINE dvb_cc (nlcc,npseu,ngm,nrxx, &
DO ng=1,ngm
aux(nl(ng)) = ga(ng) * rho_core(igtongl(ng))
ENDDO
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
!
aux(:) = aux(:) * dmuxc(:)
!
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
DO ng=1,ngm
dvb_nlcc(ng) = aux(nl(ng))
ENDDO

4
PHonon/Gamma/dvpsi_kb.f90
View File

@ -74,7 +74,7 @@ SUBROUTINE dvpsi_kb(ik,nu)
!
! dVloc/dtau in real space
!
CALL invfft ('Dense', dvloc, dfftp)
CALL invfft ('Rho', dvloc, dfftp)
DO ir = 1,dfftp%nnr
dv(ir) = dble(dvloc(ir))
ENDDO
@ -82,7 +82,7 @@ SUBROUTINE dvpsi_kb(ik,nu)
DO ng = gstart,ngm
dvb_cc (dfftp%nlm(ng))=conjg(dvb_cc(dfftp%nl(ng)))
ENDDO
CALL invfft ('Dense', dvb_cc, dfftp)
CALL invfft ('Rho', dvb_cc, dfftp)
DO ir = 1,dfftp%nnr
dv(ir) = dv(ir) + dble(dvb_cc(ir)) * dmuxc(ir)
ENDDO

2
PHonon/Gamma/dynmatcc.f90
View File

@ -51,7 +51,7 @@ SUBROUTINE dynmatcc(dyncc)
!
CALL v_xc (rho, rho_core, rhog_core, etxc, vtxc, vxc)
!
CALL fwfft ( 'Dense', vxc, dfftp )
CALL fwfft ( 'Rho', vxc, dfftp )
!
dyncc1(:,:,:,:) = 0.d0
! temporary

2
PHonon/Gamma/rhod2vkb.f90
View File

@ -52,7 +52,7 @@ SUBROUTINE rhod2vkb(dyn0)
DO ir = 1,dfftp%nnr
psic(ir) = rho%of_r(ir,current_spin)
ENDDO
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
DO nu_i = 1,nmodes
IF (has_equivalent( (nu_i-1)/3+1)==1 ) GOTO 10
DO na = 1, nat

2
PHonon/PH/addcore.f90
View File

@ -70,7 +70,7 @@ subroutine addcore (mode, drhoc)
!
! transform to real space
!
CALL invfft ('Dense', drhoc, dfftp)
CALL invfft ('Rho', drhoc, dfftp)
!
return

2
PHonon/PH/addusddens.f90
View File

@ -190,7 +190,7 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
do ig = 1, ngm
psic (dfftp%nl (ig) ) = aux (ig, is, ipert)
enddo
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
call daxpy (2*dfftp%nnr, 1.0_DP, psic, 1, drhoscf(1,is,ipert), 1)
enddo
enddo

2
PHonon/PH/addusddense.f90
View File

@ -115,7 +115,7 @@ subroutine addusddense (drhoscf, dbecsum)
do ipert = 1, 3
qg (:) = (0.d0, 0.d0)
qg (dfftp%nl (:) ) = aux (:, is, ipert)
CALL invfft ('Dense', qg, dfftp)
CALL invfft ('Rho', qg, dfftp)
drhoscf(:,is,ipert) = drhoscf(:,is,ipert) + 2.d0*qg(:)
enddo
enddo

2
PHonon/PH/addusldos.f90
View File

@ -89,7 +89,7 @@ subroutine addusldos (ldos, becsum1)
do ig = 1, ngm
psic (dfftp%nl (ig) ) = aux (ig, is)
enddo
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
call daxpy (dfftp%nnr, 1.d0, psic, 2, ldos(1,is), 2 )
enddo
endif

2
PHonon/PH/compute_dvloc.f90
View File

@ -74,7 +74,7 @@ subroutine compute_dvloc (mode, dvlocin)
! Now we compute dV_loc/dtau in real space
!
CALL invfft ('Smooth', dvlocin, dffts)
CALL invfft ('Rho', dvlocin, dffts)
call stop_clock ('com_dvloc')
return

2
PHonon/PH/dvanqq.f90
View File

@ -124,7 +124,7 @@ subroutine dvanqq
veff (ir, is) = CMPLX(v%of_r (ir, is), 0.d0,kind=DP)
enddo
endif
CALL fwfft ('Dense', veff (:, is), dfftp)
CALL fwfft ('Rho', veff (:, is), dfftp)
enddo
!
! We compute here four of the five integrals needed in the phonon

6
PHonon/PH/dvqpsi_us.f90
View File

@ -137,7 +137,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
endif
endif
enddo
CALL invfft ('Dense', drhoc, dfftp)
CALL invfft ('Rho', drhoc, dfftp)
if (.not.lsda) then
do ir=1,dfftp%nnr
aux(ir) = drhoc(ir) * dmuxc(ir,1,1)
@ -167,7 +167,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
rho%of_r(:,is) = rho%of_r(:,is) - fac * rho_core
END DO
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
! This is needed also when the smooth and the thick grids coincide to
! cut the potential at the cut-off
@ -185,7 +185,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
ikq = ikqs(ik)
npw = ngk(ikk)
npwq= ngk(ikq)
CALL invfft ('Smooth', aux1, dffts)
CALL invfft ('Rho', aux1, dffts)
do ibnd = 1, nbnd
do ip=1,npol
aux2(:) = (0.d0, 0.d0)

2
PHonon/PH/dynmat_us.f90
View File

@ -101,7 +101,7 @@ SUBROUTINE dynmat_us()
rhog (:) = rhog (:) + CMPLX(rho%of_r(:, is), 0.d0,kind=DP)
ENDDO
CALL fwfft ('Dense', rhog, dfftp)
CALL fwfft ('Rho', rhog, dfftp)
!
! there is a delta ss'
!

2
PHonon/PH/dynmatcc.f90
View File

@ -66,7 +66,7 @@ subroutine dynmatcc
end if
deallocate (v)
!
CALL fwfft ('Dense', vxc, dfftp)
CALL fwfft ('Rho', vxc, dfftp)
!
! vxc is the spin-averaged XC potential (in G-space)
!

8
PHonon/PH/ef_shift.f90
View File

@ -91,9 +91,9 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
do ipert = 1, npert (irr)
delta_n = (0.d0, 0.d0)
do is = 1, nspin_lsda
CALL fwfft ('Dense', drhoscf(:,is,ipert), dfftp)
CALL fwfft ('Rho', drhoscf(:,is,ipert), dfftp)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(dfftp%nl(1),is,ipert)
CALL invfft ('Dense', drhoscf(:,is,ipert), dfftp)
CALL invfft ('Rho', drhoscf(:,is,ipert), dfftp)
enddo
call mp_sum ( delta_n, intra_bgrp_comm )
def (ipert) = - delta_n / dos_ef
@ -243,9 +243,9 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
do ipert = 1, npert (irr)
delta_n = (0.d0, 0.d0)
do is = 1, nspin_lsda
CALL fwfft ('Dense', drhoscf(:,is,ipert), dfftp)
CALL fwfft ('Rho', drhoscf(:,is,ipert), dfftp)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(dfftp%nl(1),is,ipert)
CALL invfft ('Dense', drhoscf(:,is,ipert), dfftp)
CALL invfft ('Rho', drhoscf(:,is,ipert), dfftp)
enddo
call mp_sum ( delta_n, intra_bgrp_comm )
def (ipert) = - delta_n / dos_ef

10
PHonon/PH/localdos.f90
View File

@ -114,8 +114,8 @@ subroutine localdos_paw (ldos, ldoss, becsum1, dos_ef)
psic_nc (dffts%nl (igk_k(ig,ik)), 1 ) = evc (ig, ibnd)
psic_nc (dffts%nl (igk_k(ig,ik)), 2 ) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Smooth', psic_nc(:,1), dffts)
CALL invfft ('Smooth', psic_nc(:,2), dffts)
CALL invfft ('Rho', psic_nc(:,1), dffts)
CALL invfft ('Rho', psic_nc(:,2), dffts)
do j = 1, dffts%nnr
ldoss (j, 1) = ldoss (j, 1) + &
w1 * ( DBLE(psic_nc(j,1))**2+AIMAG(psic_nc(j,1))**2 + &
@ -143,7 +143,7 @@ subroutine localdos_paw (ldos, ldoss, becsum1, dos_ef)
do ig = 1, npw
psic (dffts%nl (igk_k(ig,ik) ) ) = evc (ig, ibnd)
enddo
CALL invfft ('Smooth', psic, dffts)
CALL invfft ('Rho', psic, dffts)
do j = 1, dffts%nnr
ldoss (j, current_spin) = ldoss (j, current_spin) + &
w1 * ( DBLE ( psic (j) ) **2 + AIMAG (psic (j) ) **2)
@ -243,9 +243,9 @@ subroutine localdos_paw (ldos, ldoss, becsum1, dos_ef)
!check
! check =0.d0
! do is=1,nspin_mag
! call fwfft('Dense',ldos(:,is),dfftp)
! call fwfft('Rho',ldos(:,is),dfftp)
! check = check + omega* DBLE(ldos(nl(1),is))
! call invfft('Dense',ldos(:,is),dfftp)
! call invfft('Rho',ldos(:,is),dfftp)
! end do
! WRITE( stdout,*) ' check ', check, dos_ef
!check

2
PP/src/add_shift_cc.f90
View File

@ -75,7 +75,7 @@ SUBROUTINE add_shift_cc (shift_cc)
ENDDO
ENDIF
DEALLOCATE (vxc)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
! psic contains now Vxc(G)
!

2
PP/src/add_shift_lc.f90
View File

@ -66,7 +66,7 @@ SUBROUTINE add_shift_lc (nat, tau, ityp, alat, omega, ngm, ngl, &
ELSE
aux(:) = CMPLX ( rho(:,1), 0.0_dp, KIND=dp )
END IF
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
! aux contains now n(G)
!

2
PP/src/bgw2pw.f90
View File

@ -866,7 +866,7 @@ SUBROUTINE write_cd ( input_file_name, real_or_complex, output_dir_name )
DO ig = 1, ngm
psic ( dfftp%nl ( ig ) ) = rho%of_g ( ig, is )
ENDDO
CALL invfft ( 'Dense', psic, dfftp )
CALL invfft ( 'Rho', psic, dfftp )
DO ir = 1, dfftp%nnr
rho%of_r ( ir, is ) = psic ( ir )
ENDDO

2
PP/src/chdens_module.f90
View File

@ -485,7 +485,7 @@ SUBROUTINE chdens (plot_files,plot_num)
#else
psic(:) = cmplx(rhor(:), 0.d0,kind=DP)
#endif
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
! we store the fourier components in the array rhog
!

8
PP/src/elf.f90
View File

@ -114,7 +114,7 @@ SUBROUTINE do_elf (elf)
CALL sym_rho_init ( gamma_only )
!
aux(:) = cmplx ( kkin (:), 0.0_dp, kind=dp)
CALL fwfft ('Smooth', aux, dffts)
CALL fwfft ('Rho', aux, dffts)
ALLOCATE (aux2(ngm))
aux2(:) = aux(dfftp%nl(:))
!
@ -125,7 +125,7 @@ SUBROUTINE do_elf (elf)
aux(:) = (0.0_dp, 0.0_dp)
aux(dfftp%nl(:)) = aux2(:)
DEALLOCATE (aux2)
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
kkin (:) = dble(aux(:))
!
ENDIF
@ -144,7 +144,7 @@ SUBROUTINE do_elf (elf)
ENDDO
!
aux(:) = cmplx( rho%of_r(:, 1), 0.d0 ,kind=DP)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
DO j = 1, 3
aux2(:) = (0.d0,0.d0)
@ -157,7 +157,7 @@ SUBROUTINE do_elf (elf)
ENDDO
ENDIF
CALL invfft ('Dense', aux2, dffts)
CALL invfft ('Rho', aux2, dffts)
DO i = 1, dfftp%nnr
tbos (i) = tbos (i) + dble(aux2(i))**2
ENDDO

4
PP/src/local_dos.f90
View File

@ -407,14 +407,14 @@ SUBROUTINE local_dos (iflag, lsign, kpoint, kband, spin_component, &
CALL sym_rho_init (gamma_only )
!
psic(:) = cmplx ( dos(:), 0.0_dp, kind=dp)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%of_g(:,1) = psic(dfftp%nl(:))
!
CALL sym_rho (1, rho%of_g)
!
psic(:) = (0.0_dp, 0.0_dp)
psic(dfftp%nl(:)) = rho%of_g(:,1)
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
dos(:) = dble(psic(:))
!
CALL sym_rho_deallocate()

2
PP/src/local_dos1d.f90
View File

@ -216,7 +216,7 @@ SUBROUTINE local_dos1d (ik, kband, plan)
DO ir = 1, dfftp%nnr
prho (ir) = cmplx(aux (ir), 0.d0,kind=DP)
ENDDO
CALL fwfft ('Dense', prho, dfftp)
CALL fwfft ('Rho', prho, dfftp)
!
! Here we add the US contribution to the charge for the atoms which n
! it. Or compute the planar average in the NC case.

4
PP/src/projwfc_box.f90
View File

@ -239,7 +239,7 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox
ENDDO
raux=0._DP
DO ipol=1,npol
CALL invfft ('Dense', psic_nc(:,ipol), dfftp)
CALL invfft ('Rho', psic_nc(:,ipol), dfftp)
raux(:) = raux(:)+dble( psic_nc(:,ipol) )**2 &
+ aimag( psic_nc(:,ipol) )**2
ENDDO
@ -255,7 +255,7 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox
caux (dfftp%nlm(igk_k (ig,ik) ) ) = conjg(evc (ig, ibnd))
ENDDO
ENDIF
CALL invfft ('Dense', caux, dfftp)
CALL invfft ('Rho', caux, dfftp)
!
raux(:) = dble( caux(:) )**2 + aimag( caux(:) )**2
!

24
PP/src/pw2bgw.f90
View File

@ -1459,7 +1459,7 @@ SUBROUTINE calc_rhog (rhog_nvmin, rhog_nvmax)
DO ig = 1, npw
psic (dfftp%nl (igk_k (ig, ik-iks+1))) = evc (ig, ib)
ENDDO
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
DO ir = 1, dfftp%nnr
rho%of_r (ir, is) = rho%of_r (ir, is) + wg (ib, ik) / omega &
* (dble (psic (ir)) **2 + aimag (psic (ir)) **2)
@ -1472,7 +1472,7 @@ SUBROUTINE calc_rhog (rhog_nvmin, rhog_nvmax)
DO is = 1, nspin
psic (:) = (0.0D0, 0.0D0)
psic (:) = rho%of_r (:, is)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%of_g (:, is) = psic (dfftp%nl (:))
ENDDO
@ -1654,7 +1654,7 @@ SUBROUTINE write_vxcg ( output_file_name, real_or_complex, symm_type, &
DO ir = 1, nr
psic ( ir ) = CMPLX ( vxcr_g ( ir, is ), 0.0D0, KIND=dp )
ENDDO
CALL fwfft ( 'Dense', psic, dfftp )
CALL fwfft ( 'Rho', psic, dfftp )
DO ig = 1, ng_l
vxcg_g ( ig_l2g ( ig ), is ) = psic ( dfftp%nl ( ig ) )
ENDDO
@ -1751,7 +1751,7 @@ SUBROUTINE write_vxc0 ( output_file_name, vxc_zero_rho_core )
DO ir = 1, nr
psic ( ir ) = CMPLX ( vxcr_g ( ir, is ), 0.0D0, KIND=dp )
ENDDO
CALL fwfft ( 'Dense', psic, dfftp )
CALL fwfft ( 'Rho', psic, dfftp )
DO ig = 1, ng_l
IF ( mill ( 1, ig ) .EQ. 0 .AND. mill ( 2, ig ) .EQ. 0 .AND. &
mill ( 3, ig ) .EQ. 0 ) vxc0_g ( is ) = psic ( dfftp%nl ( ig ) )
@ -1883,7 +1883,7 @@ SUBROUTINE write_vxc_r (output_file_name, diag_nmin, diag_nmax, &
DO ig = 1, npw
psic (dfftp%nl (igk_k (ig,ik-iks+1))) = evc (ig, ib)
ENDDO
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
dummyr = 0.0D0
DO ir = 1, dfftp%nnr
dummyr = dummyr + vxcr (ir, isk (ik)) &
@ -1900,13 +1900,13 @@ SUBROUTINE write_vxc_r (output_file_name, diag_nmin, diag_nmax, &
DO ig = 1, npw
psic (dfftp%nl (igk_k (ig,ik-iks+1))) = evc (ig, ib)
ENDDO
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
DO ib2 = offdiag_nmin, offdiag_nmax
psic2 (:) = (0.0D0, 0.0D0)
DO ig = 1, npw
psic2 (dfftp%nl (igk_k (ig,ik-iks+1))) = evc (ig, ib2)
ENDDO
CALL invfft ('Dense', psic2, dfftp)
CALL invfft ('Rho', psic2, dfftp)
dummyc = (0.0D0, 0.0D0)
DO ir = 1, dfftp%nnr
dummyc = dummyc + CMPLX (vxcr (ir, isk (ik)), 0.0D0, KIND=dp) &
@ -2071,11 +2071,11 @@ SUBROUTINE write_vxc_g (output_file_name, diag_nmin, diag_nmax, &
DO ig = 1, npw
psic (dfftp%nl (igk_k(ig,ikk))) = evc (ig, ib)
ENDDO
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
DO ir = 1, dfftp%nnr
psic (ir) = psic (ir) * vxcr (ir, isk (ik))
ENDDO
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
hpsi (:) = (0.0D0, 0.0D0)
DO ig = 1, npw
hpsi (ig) = psic (dfftp%nl (igk_k(ig,ikk)))
@ -2101,11 +2101,11 @@ SUBROUTINE write_vxc_g (output_file_name, diag_nmin, diag_nmax, &
DO ig = 1, npw
psic (dfftp%nl (igk_k(ig,ikk))) = evc (ig, ib)
ENDDO
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
DO ir = 1, dfftp%nnr
psic (ir) = psic (ir) * vxcr (ir, isk (ik))
ENDDO
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
hpsi (:) = (0.0D0, 0.0D0)
DO ig = 1, npw
hpsi (ig) = psic (dfftp%nl (igk_k (ig,ikk)))
@ -2347,7 +2347,7 @@ SUBROUTINE write_vscg ( output_file_name, real_or_complex, symm_type )
DO ir = 1, nr
psic ( ir ) = CMPLX ( v%of_r ( ir, is ) + vltot ( ir ), 0.0D0, KIND=dp )
ENDDO
CALL fwfft ( 'Dense', psic, dfftp )
CALL fwfft ( 'Rho', psic, dfftp )
DO ig = 1, ng_l
vscg_g ( ig_l2g ( ig ), is ) = psic ( dfftp%nl ( ig ) )
ENDDO

2
PP/src/pw2gw.f90
View File

@ -800,7 +800,7 @@ SUBROUTINE compute_gw( omegamin, omegamax, d_omega, use_gmaps, qplda, vkb, vxcdi
psic(dfftp%nl(igk_k(ig,ik))) = evc(ig,iband1)
ENDDO
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
vxcdiag = 0.0d0
!norma = 0.0d0
DO ir = 1, dfftp%nnr

8
PP/src/stm.f90
View File

@ -184,7 +184,7 @@ SUBROUTINE stm (sample_bias, stmdos, istates)
ENDDO
ENDIF
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
DO ir = 1, dfftp%nnr
rho%of_r (ir, 1) = rho%of_r (ir, 1) + w1* dble( psic(ir) )**2 + &
w2*aimag( psic(ir) )**2
@ -206,7 +206,7 @@ SUBROUTINE stm (sample_bias, stmdos, istates)
psic(dfftp%nl(igk_k(ig,ik))) = evc(ig,ibnd)
ENDDO
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
DO ir = 1, dfftp%nnr
rho%of_r (ir, 1) = rho%of_r (ir, 1) + w1 * &
( dble(psic (ir) ) **2 + aimag(psic (ir) ) **2)
@ -225,12 +225,12 @@ SUBROUTINE stm (sample_bias, stmdos, istates)
CALL sym_rho_init (gamma_only)
!
psic(:) = cmplx ( rho%of_r(:,1), 0.0_dp, kind=dp)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%of_g(:,1) = psic(dfftp%nl(:))
CALL sym_rho (1, rho%of_g)
psic(:) = (0.0_dp, 0.0_dp)
psic(dfftp%nl(:)) = rho%of_g(:,1)
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rho%of_r(:,1) = dble(psic(:))
ENDIF
#if defined(__MPI)

12
PP/src/sym_band.f90
View File

@ -401,7 +401,7 @@ SUBROUTINE find_band_sym (ik,evc,et,nsym,s,ftau,gk,invs,rap_et,times,ngroup,&
psic=(0.0_DP,0.0_DP)
DO ibnd=1,nbnd
psic(dfftp%nl(igk_k(1:npw,ik)),ibnd) = evc(1:npw,ibnd)
CALL invfft ('Dense', psic(:,ibnd), dfftp)
CALL invfft ('Rho', psic(:,ibnd), dfftp)
ENDDO
!
! Find the character of one symmetry operation per class
@ -618,7 +618,7 @@ SUBROUTINE rotate_all_psi(ik,psic,evcr,s,ftau,gk)
CALL cscatter_sym_many( dfftp, psic_collect, psir, ibnd, nbnd, &
nbnd_proc, start_band_proc )
!
CALL fwfft ('Dense', psir, dfftp)
CALL fwfft ('Rho', psir, dfftp)
!
evcr(1:npw,ibnd) = psir(dfftp%nl(igk_k(1:npw,ik)))
END DO
@ -654,7 +654,7 @@ SUBROUTINE rotate_all_psi(ik,psic,evcr,s,ftau,gk)
ENDDO
ENDDO
ENDIF
CALL fwfft ('Dense', psir, dfftp)
CALL fwfft ('Rho', psir, dfftp)
!
evcr(1:npw,ibnd) = psir(dfftp%nl(igk_k(1:npw,ik)))
ENDDO
@ -946,7 +946,7 @@ SUBROUTINE rotate_all_psi_so(ik,evc_nc,evcr,s,ftau,d_spin,has_e,gk)
!
DO ibnd=1,nbnd
psic(dfftp%nl(igk_k(1:npw,ik)),ibnd) = evc_nc(1:npw,ipol,ibnd)
CALL invfft ('Dense', psic(:,ibnd), dfftp)
CALL invfft ('Rho', psic(:,ibnd), dfftp)
ENDDO
!
#if defined (__MPI)
@ -990,7 +990,7 @@ SUBROUTINE rotate_all_psi_so(ik,evc_nc,evcr,s,ftau,d_spin,has_e,gk)
!
CALL cscatter_sym_many(dfftp, psic_collect, psir, ibnd, nbnd, nbnd_proc, &
start_band_proc)
CALL fwfft ('Dense', psir, dfftp)
CALL fwfft ('Rho', psir, dfftp)
!
evcr_save(1:npw,ipol,ibnd) = psir(dfftp%nl(igk_k(1:npw,ik)))
ENDDO
@ -1023,7 +1023,7 @@ SUBROUTINE rotate_all_psi_so(ik,evc_nc,evcr,s,ftau,d_spin,has_e,gk)
ENDDO
ENDDO
ENDIF
CALL fwfft ('Dense', psir(:), dfftp)
CALL fwfft ('Rho', psir(:), dfftp)
!
evcr_save(1:npw,ipol,ibnd) = psir(dfftp%nl(igk_k(1:npw,ik)))
ENDDO

2
PW/src/addusdens.f90
View File

@ -166,7 +166,7 @@ SUBROUTINE addusdens_g(rho)
psic(:) = (0.d0, 0.d0)
psic( dfftp%nl(:) ) = aux(:,is)
IF (gamma_only) psic( dfftp%nlm(:) ) = CONJG (aux(:,is))
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rho(:, is) = rho(:, is) + DBLE (psic (:) )
ENDDO
#ifdef DEBUG_ADDUSDENS

2
PW/src/addusforce.f90
View File

@ -83,7 +83,7 @@ SUBROUTINE addusforce_g (forcenl)
ELSE
aux(:) = vltot (:) + v%of_r (:, is)
ENDIF
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
! Note the factors -i and 2pi/a *units of G) here in V(G) !
vg (:, is) = aux(dfftp%nl (:) ) * tpiba * (0.d0, -1.d0)
ENDDO

2
PW/src/addusstress.f90
View File

@ -92,7 +92,7 @@ SUBROUTINE addusstress_g (sigmanlc)
ELSE
aux(:) = vltot(:) + v%of_r(:,is)
ENDIF
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
DO ig = 1, ngm
vg (ig, is) = aux (dfftp%nl (ig) )
ENDDO

2
PW/src/atomic_rho.f90
View File

@ -154,7 +154,7 @@ subroutine atomic_rho (rhoa, nspina)
psic(:) = (0.d0,0.d0)
psic (dfftp%nl (:) ) = rhocg (:, is)
if (gamma_only) psic ( dfftp%nlm(:) ) = CONJG( rhocg (:, is) )
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
!
! we check that everything is correct
!

10
PW/src/data_structure.f90
View File

@ -59,10 +59,12 @@ SUBROUTINE data_structure( gamma_only )
! ... set up fft descriptors, including parallel stuff: sticks, planes, etc.
!
dffts%have_task_groups = (ntask_groups >1)
CALL fft_type_init( dffts, smap, "wave", gamma_only, lpara, intra_bgrp_comm,&
at, bg, gkcut, gcutms/gkcut, nyfft=nyfft )
CALL fft_type_init( dfftp, smap, "rho" , gamma_only, lpara, intra_bgrp_comm,&
at, bg, gcutm , 4.d0, nyfft=nyfft )
CALL fft_type_init( dffts, smap, "wave", gamma_only, lpara, intra_bgrp_comm, at, bg, gkcut, gcutms/gkcut, nyfft=nyfft )
CALL fft_type_init( dfftp, smap, "rho" , gamma_only, lpara, intra_bgrp_comm, at, bg, gcutm , 4.d0, nyfft=nyfft )
! define the clock labels ( this enables the corresponding fft too ! )
dffts%rho_clock_label='ffts' ; dffts%wave_clock_label='fftw'
dfftp%rho_clock_label='fft'
CALL fft_base_info( ionode, stdout )
ngs_ = dffts%ngl( dffts%mype + 1 )
ngm_ = dfftp%ngl( dfftp%mype + 1 )

70
PW/src/exx.f90
View File

@ -281,6 +281,8 @@ MODULE exx
CALL ggent( intra_egrp_comm, dfftt, gcutmt, ecutwfc/tpiba2, ngmt_g, exx_fft )
!
END IF
! define clock labels (this enables the corresponding fft too)
dfftt%rho_clock_label = 'fftc' ; dfftt%wave_clock_label = 'fftcw'
!
WRITE( stdout, '(/5x,"EXX grid: ",i8," G-vectors", 5x, &
& "FFT dimensions: (",i4,",",i4,",",i4,")")') ngmt_g, &
@ -1056,7 +1058,7 @@ MODULE exx
ENDDO
ENDIF
CALL invfft ('CustomWave', psic_exx, dfftt)
CALL invfft ('Wave', psic_exx, dfftt)
IF(DoLoc) then
locbuff(1:nrxxs,ibnd-ibnd_loop_start+evc_offset+1,ik)=Dble( psic_exx(1:nrxxs) )
IF(ibnd-ibnd_loop_start+evc_offset+2.le.nbnd) &
@ -1085,13 +1087,13 @@ MODULE exx
temppsic_nc(dfftt%nl(igk_exx(ig,ik)),1) = evc_exx(ig,ibnd-iexx_start+1)
ENDDO
!$omp end parallel do
CALL invfft ('CustomWave', temppsic_nc(:,1), dfftt)
CALL invfft ('Wave', temppsic_nc(:,1), dfftt)
!$omp parallel do default(shared) private(ig) firstprivate(npw,ik,ibnd_exx,npwx)
DO ig=1,npw
temppsic_nc(dfftt%nl(igk_exx(ig,ik)),2) = evc_exx(ig+npwx,ibnd-iexx_start+1)
ENDDO
!$omp end parallel do
CALL invfft ('CustomWave', temppsic_nc(:,2), dfftt)
CALL invfft ('Wave', temppsic_nc(:,2), dfftt)
ELSE
!$omp parallel do default(shared) private(ir) firstprivate(nrxxs)
DO ir=1,nrxxs
@ -1102,7 +1104,7 @@ MODULE exx
temppsic(dfftt%nl(igk_exx(ig,ik))) = evc_exx(ig,ibnd-iexx_start+1)
ENDDO
!$omp end parallel do
CALL invfft ('CustomWave', temppsic, dfftt)
CALL invfft ('Wave', temppsic, dfftt)
ENDIF
!
DO ikq=1,nkqs
@ -1548,7 +1550,7 @@ MODULE exx
ENDIF
!
IF( l_fft_doubleband.or.l_fft_singleband) THEN
CALL invfft ('CustomWave', psiwork, dfftt)
CALL invfft ('Wave', psiwork, dfftt)
!$omp parallel do default(shared), private(ir)
DO ir = 1, nrxxs
temppsic_dble(ir) = dble ( psiwork(ir) )
@ -1634,7 +1636,7 @@ MODULE exx
_CY(becxx(ikq)%r(:,jbnd+1)),_CX(becpsi%r(:,ibnd)))
ENDIF
!
CALL fwfft ('Custom', rhoc(:,ii), dfftt)
CALL fwfft ('Rho', rhoc(:,ii), dfftt)
! >>>> add augmentation in G SPACE here
IF(okvan .and. .not. tqr) THEN
! contribution from one band added to real (in real space) part of rhoc
@ -1670,7 +1672,7 @@ MODULE exx
ENDIF
!
!brings back v in real space
CALL invfft ('Custom', vc(:,ii), dfftt)
CALL invfft ('Rho', vc(:,ii), dfftt)
!
! >>>> compute <psi|H_fock REAL SPACE here
IF(okvan .and. tqr) THEN
@ -1722,7 +1724,7 @@ MODULE exx
!
! brings back result in G-space
!
CALL fwfft( 'CustomWave' , result(:,ii), dfftt )
CALL fwfft( 'Wave' , result(:,ii), dfftt )
!communicate result
DO ig = 1, n
big_result(ig,ibnd) = big_result(ig,ibnd) - exxalfa*result(dfftt%nl(igk_exx(ig,current_k)),ii)
@ -1890,8 +1892,8 @@ MODULE exx
ENDDO
!$omp end parallel do
!
CALL invfft ('CustomWave', temppsic_nc(:,1,ii), dfftt)
CALL invfft ('CustomWave', temppsic_nc(:,2,ii), dfftt)
CALL invfft ('Wave', temppsic_nc(:,1,ii), dfftt)
CALL invfft ('Wave', temppsic_nc(:,2,ii), dfftt)
!
ELSE
!
@ -1901,7 +1903,7 @@ MODULE exx
ENDDO
!$omp end parallel do
!
CALL invfft ('CustomWave', temppsic(:,ii), dfftt)
CALL invfft ('Wave', temppsic(:,ii), dfftt)
!
END IF
!
@ -2032,10 +2034,10 @@ MODULE exx
!
! >>>> brings it to G-space
#if defined(__USE_MANY_FFT)
CALL fwfft ('Custom', prhoc, dfftt, howmany=jcount)
CALL fwfft ('Rho', prhoc, dfftt, howmany=jcount)
#else
DO jbnd=jstart, jend
CALL fwfft('Custom', rhoc(:,jbnd-jstart+1), dfftt)
CALL fwfft('Rho', rhoc(:,jbnd-jstart+1), dfftt)
ENDDO
#endif
!
@ -2079,10 +2081,10 @@ MODULE exx
!brings back v in real space
#if defined(__USE_MANY_FFT)
!fft many
CALL invfft ('Custom', pvc, dfftt, howmany=jcount)
CALL invfft ('Rho', pvc, dfftt, howmany=jcount)
#else
DO jbnd=jstart, jend
CALL invfft('Custom', vc(:,jbnd-jstart+1), dfftt)
CALL invfft('Rho', vc(:,jbnd-jstart+1), dfftt)
ENDDO
#endif
!
@ -2155,15 +2157,15 @@ MODULE exx
!
IF (noncolin) THEN
!brings back result in G-space
CALL fwfft ('CustomWave', result_nc(:,1,ii), dfftt)
CALL fwfft ('CustomWave', result_nc(:,2,ii), dfftt)
CALL fwfft ('Wave', result_nc(:,1,ii), dfftt)
CALL fwfft ('Wave', result_nc(:,2,ii), dfftt)
DO ig = 1, n
big_result(ig,ibnd) = big_result(ig,ibnd) - exxalfa*result_nc(dfftt%nl(igk_exx(ig,current_k)),1,ii)
big_result(n+ig,ibnd) = big_result(n+ig,ibnd) - exxalfa*result_nc(dfftt%nl(igk_exx(ig,current_k)),2,ii)
ENDDO
ELSE
!
CALL fwfft ('CustomWave', result(:,ii), dfftt)
CALL fwfft ('Wave', result(:,ii), dfftt)
DO ig = 1, n
big_result(ig,ibnd) = big_result(ig,ibnd) - exxalfa*result(dfftt%nl(igk_exx(ig,current_k)),ii)
ENDDO
@ -2659,7 +2661,7 @@ MODULE exx
ENDIF
!
IF( l_fft_doubleband.or.l_fft_singleband) THEN
CALL invfft ('CustomWave', temppsic, dfftt)
CALL invfft ('Wave', temppsic, dfftt)
!$omp parallel do default(shared), private(ir)
DO ir = 1, nrxxs
temppsic_dble(ir) = dble ( temppsic(ir) )
@ -2742,7 +2744,7 @@ MODULE exx
ENDIF
!
! bring rhoc to G-space
CALL fwfft ('Custom', rhoc, dfftt)
CALL fwfft ('Rho', rhoc, dfftt)
!
IF(okvan .and..not.tqr) THEN
IF(ibnd>=istart ) &
@ -2937,8 +2939,8 @@ MODULE exx
ENDDO
!$omp end parallel do
!
CALL invfft ('CustomWave', temppsic_nc(:,1,ii), dfftt)
CALL invfft ('CustomWave', temppsic_nc(:,2,ii), dfftt)
CALL invfft ('Wave', temppsic_nc(:,1,ii), dfftt)
CALL invfft ('Wave', temppsic_nc(:,2,ii), dfftt)
!
ELSE
!$omp parallel do default(shared), private(ig)
@ -2947,7 +2949,7 @@ MODULE exx
ENDDO
!$omp end parallel do
!
CALL invfft ('CustomWave', temppsic(:,ii), dfftt)
CALL invfft ('Wave', temppsic(:,ii), dfftt)
!
ENDIF
END DO
@ -3056,10 +3058,10 @@ MODULE exx
!
! bring rhoc to G-space
#if defined(__USE_MANY_FFT)
CALL fwfft ('Custom', prhoc, dfftt, howmany=ibnd_inner_count)
CALL fwfft ('Rho', prhoc, dfftt, howmany=ibnd_inner_count)
#else
DO ibnd=ibnd_inner_start, ibnd_inner_end
CALL fwfft('Custom', rhoc(:,ibnd-ibnd_inner_start+1), dfftt)
CALL fwfft('Rho', rhoc(:,ibnd-ibnd_inner_start+1), dfftt)
ENDDO
#endif
@ -3490,7 +3492,7 @@ MODULE exx
!$omp end parallel do
ENDIF
CALL invfft ('CustomWave', temppsic, dfftt)
CALL invfft ('Wave', temppsic, dfftt)
IF (gamma_only) THEN
!
@ -3532,7 +3534,7 @@ MODULE exx
ENDDO
!$omp end parallel do
! bring it to G-space
CALL fwfft ('Custom', rhoc, dfftt)
CALL fwfft ('Rho', rhoc, dfftt)
vc = 0._dp
!$omp parallel do default(shared), private(ig), reduction(+:vc)
@ -3567,7 +3569,7 @@ MODULE exx
!$omp end parallel do
! bring it to G-space
CALL fwfft ('Custom', rhoc, dfftt)
CALL fwfft ('Rho', rhoc, dfftt)
vc = 0._dp
!$omp parallel do default(shared), private(ig), reduction(+:vc)
@ -5663,13 +5665,13 @@ implicit none
DO ir = 1, NQR
rhoc(ir) = locbuff(ir,ibnd,ikq) * locbuff(ir,ibnd,ikq) / omega
ENDDO
CALL fwfft ('Custom', rhoc, dfftt)
CALL fwfft ('Rho', rhoc, dfftt)
vc=(0.0d0, 0.0d0)
DO ig = 1, dfftt%ngm
vc(dfftt%nl(ig)) = fac(ig) * rhoc(dfftt%nl(ig))
vc(dfftt%nlm(ig)) = fac(ig) * rhoc(dfftt%nlm(ig))
ENDDO
CALL invfft ('Custom', vc, dfftt)
CALL invfft ('Rho', vc, dfftt)
DO ir = 1, NQR
RESULT(ir,ibnd) = RESULT(ir,ibnd) + locbuff(ir,ibnd,nkqs) * vc(ir)
ENDDO
@ -5685,13 +5687,13 @@ implicit none
rhoc(ir) = locbuff(ir,ibnd,ikq) * locbuff(ir,kbnd,ikq) / omega
ENDDO
npairs = npairs + 1
CALL fwfft ('Custom', rhoc, dfftt)
CALL fwfft ('Rho', rhoc, dfftt)
vc=(0.0d0, 0.0d0)
DO ig = 1, dfftt%ngm
vc(dfftt%nl(ig)) = fac(ig) * rhoc(dfftt%nl(ig))
vc(dfftt%nlm(ig)) = fac(ig) * rhoc(dfftt%nlm(ig))
ENDDO
CALL invfft ('Custom', vc, dfftt)
CALL invfft ('Rho', vc, dfftt)
DO ir = 1, NQR
RESULT(ir,kbnd) = RESULT(ir,kbnd) + x_occupation(ibnd,ikq) * locbuff(ir,ibnd,nkqs) * vc(ir)
ENDDO
@ -5705,7 +5707,7 @@ implicit none
ENDDO
DO jbnd = 1, nbnd
CALL fwfft( 'CustomWave' , RESULT(:,jbnd), dfftt )
CALL fwfft( 'Wave' , RESULT(:,jbnd), dfftt )
DO ig = 1, npw
hpsi(ig,jbnd) = hpsi(ig,jbnd) - exxalfa*RESULT(dfftt%nl(ig),jbnd)
ENDDO
@ -5720,7 +5722,7 @@ implicit none
RESULT = (0.0d0,0.0d0)
DO jbnd = 1, nbnd
rhoc(:) = dble(locbuff(:,jbnd,nkqs)) + (0.0d0,1.0d0)*0.0d0
CALL fwfft( 'CustomWave' , rhoc, dfftt )
CALL fwfft( 'Wave' , rhoc, dfftt )
DO ig = 1, npw
RESULT(ig,jbnd) = rhoc(dfftt%nl(ig))
ENDDO

2
PW/src/force_cc.f90
View File

@ -77,7 +77,7 @@ subroutine force_cc (forcecc)
enddo
endif
deallocate (vxc)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
! psic contains now Vxc(G)
!

2
PW/src/force_corr.f90
View File

@ -59,7 +59,7 @@ subroutine force_corr (forcescc)
forcescc(:,:) = 0.d0
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
if (gamma_only) then
fact = 2.d0

2
PW/src/force_lc.f90
View File

@ -65,7 +65,7 @@ subroutine force_lc (nat, tau, ityp, alat, omega, ngm, ngl, &
else
aux(:) = CMPLX( rho(:,1), 0.0_dp, kind=dp )
end if
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
! aux contains now n(G)
!

26
PW/src/gradcorr.f90
View File

@ -83,7 +83,7 @@ SUBROUTINE gradcorr( rho, rhog, rho_core, rhog_core, etxc, vtxc, v )
!
psic(:) = rhoout(:,is)
!
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
rhogsum(:,is) = psic(dfftp%nl(:))
!
@ -339,7 +339,7 @@ SUBROUTINE gradrho( nrxx, a, ngm, g, nl, ga )
!
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
!
! ...and add the factor 2\pi/a missing in the definition of G
!
@ -384,7 +384,7 @@ SUBROUTINE gradient( nrxx, a, ngm, g, nl, ga )
!
! ... bring a(r) to G-space, a(G) ...
!
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
! ... multiply by (iG) to get (\grad_ipol a)(G) ...
!
@ -403,7 +403,7 @@ SUBROUTINE gradient( nrxx, a, ngm, g, nl, ga )
!
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
!
! ...and add the factor 2\pi/a missing in the definition of G
!
@ -448,7 +448,7 @@ SUBROUTINE exx_gradient( nrxx, a, ngm, g, nl, ga )
!
! ... bring a(r) to G-space, a(G) ...
!
CALL fwfft ('Custom', aux, dfftt)
CALL fwfft ('Rho', aux, dfftt)
!
! ... multiply by (iG) to get (\grad_ipol a)(G) ...
!
@ -467,7 +467,7 @@ SUBROUTINE exx_gradient( nrxx, a, ngm, g, nl, ga )
!
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL invfft ('Custom', gaux, dfftt)
CALL invfft ('Rho', gaux, dfftt)
!
! ...and add the factor 2\pi/a missing in the definition of G
!
@ -515,7 +515,7 @@ SUBROUTINE grad_dot( nrxx, a, ngm, g, nl, alat, da )
!
! ... bring a(ipol,r) to G-space, a(G) ...
!
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
DO n = 1, ngm
!
@ -538,7 +538,7 @@ SUBROUTINE grad_dot( nrxx, a, ngm, g, nl, alat, da )
!
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
!
! ... add the factor 2\pi/a missing in the definition of G and sum
!
@ -583,7 +583,7 @@ SUBROUTINE hessian( nrxx, a, ngm, g, nl, ga, ha )
!
! ... bring a(r) to G-space, a(G) ...
!
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
! ... multiply by (iG) to get (\grad_ipol a)(G) ...
!
@ -602,7 +602,7 @@ SUBROUTINE hessian( nrxx, a, ngm, g, nl, ga, ha )
!
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
!
! ...and add the factor 2\pi/a missing in the definition of G
!
@ -625,7 +625,7 @@ SUBROUTINE hessian( nrxx, a, ngm, g, nl, ga, ha )
!
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL invfft ('Dense', haux, dfftp)
CALL invfft ('Rho', haux, dfftp)
!
! ...and add the factor 2\pi/a missing in the definition of G
!
@ -677,7 +677,7 @@ SUBROUTINE laplacian( nrxx, a, ngm, gg, nl, lapla )
!
! ... bring a(r) to G-space, a(G) ...
!
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
! ... Compute the laplacian
!
@ -697,7 +697,7 @@ SUBROUTINE laplacian( nrxx, a, ngm, gg, nl, lapla )
!
! ... bring back to R-space, (\lapl a)(r) ...
!
CALL invfft ('Dense', laux, dfftp)
CALL invfft ('Rho', laux, dfftp)
!
! ... add the missing factor (2\pi/a)^2 in G
!

25
PW/src/interpolate.f90
View File

@ -5,7 +5,6 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
subroutine interpolate (v, vs, iflag)
!
! This subroutine interpolates :
@ -44,7 +43,7 @@ subroutine interpolate (v, vs, iflag)
allocate (aux( dfftp%nnr))
allocate (auxs(dffts%nnr))
aux (:) = v (:)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
auxs (:) = (0.d0, 0.d0)
do ig = 1, ngms
auxs (dffts%nl (ig) ) = aux (dfftp%nl (ig) )
@ -54,7 +53,7 @@ subroutine interpolate (v, vs, iflag)
auxs (dffts%nlm(ig) ) = aux (dfftp%nlm(ig) )
enddo
end if
CALL invfft ('Smooth', auxs, dffts)
CALL invfft ('Rho', auxs, dffts)
vs (:) = auxs (:)
deallocate (auxs)
deallocate (aux)
@ -71,7 +70,7 @@ subroutine interpolate (v, vs, iflag)
allocate (aux( dfftp%nnr))
allocate (auxs(dffts%nnr))
auxs (:) = vs (:)
CALL fwfft ('Smooth', auxs, dffts)
CALL fwfft ('Rho', auxs, dffts)
aux (:) = (0.d0, 0.d0)
do ig = 1, ngms
aux (dfftp%nl (ig) ) = auxs (dffts%nl (ig) )
@ -81,7 +80,7 @@ subroutine interpolate (v, vs, iflag)
aux (dfftp%nlm(ig) ) = auxs (dffts%nlm(ig) )
enddo
end if
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
v (:) = aux (:)
deallocate (auxs)
deallocate (aux)
@ -133,12 +132,12 @@ subroutine cinterpolate (v, vs, iflag)
if (doublegrid) then
allocate (aux ( dfftp%nnr))
aux (:) = v(:)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
vs (:) = (0.d0, 0.d0)
do ig = 1, ngms
vs (dffts%nl (ig) ) = aux (dfftp%nl (ig) )
enddo
CALL invfft ('Smooth', vs, dffts)
CALL invfft ('Rho', vs, dffts)
deallocate (aux)
else
call zcopy (dfftp%nnr, v, 1, vs, 1)
@ -150,12 +149,12 @@ subroutine cinterpolate (v, vs, iflag)
if (doublegrid) then
allocate (auxs (dffts%nnr))
auxs (:) = vs(:)
CALL fwfft ('Smooth', auxs, dffts)
CALL fwfft ('Rho', auxs, dffts)
v (:) = (0.d0, 0.d0)
do ig = 1, ngms
v (dfftp%nl (ig) ) = auxs (dffts%nl (ig) )
enddo
CALL invfft ('Dense', v, dfftp)
CALL invfft ('Rho', v, dfftp)
deallocate (auxs)
else
call zcopy (dfftp%nnr, vs, 1, v, 1)
@ -204,7 +203,7 @@ subroutine exx_interpolate (v, vs, iflag)
allocate (aux( dfftp%nnr))
allocate (auxs(dfftt%nnr))
aux (:) = (1.0d0,0.0d0) * v (:)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
auxs (:) = (0.d0, 0.d0)
do ig = 1, dfftt%ngm
auxs (dfftt%nl(ig)) = aux(dfftp%nl(ig))
@ -214,7 +213,7 @@ subroutine exx_interpolate (v, vs, iflag)
auxs(dfftt%nlm(ig) ) = aux (dfftp%nlm(ig) )
enddo
end if
CALL invfft ('Custom', auxs, dfftt)
CALL invfft ('Rho', auxs, dfftt)
vs (:) = real(auxs (:))
deallocate (auxs)
deallocate (aux)
@ -225,7 +224,7 @@ subroutine exx_interpolate (v, vs, iflag)
allocate (aux( dfftp%nnr))
allocate (auxs(dfftt%nnr))
auxs (:) = vs (:)
CALL fwfft ('Custom', auxs, dfftt)
CALL fwfft ('Rho', auxs, dfftt)
aux (:) = (0.d0, 0.d0)
do ig = 1, dfftt%ngm
aux (dfftp%nl (ig) ) = auxs (dfftt%nl (ig) )
@ -235,7 +234,7 @@ subroutine exx_interpolate (v, vs, iflag)
aux (dfftp%nlm(ig) ) = auxs (dfftt%nlm(ig) )
enddo
end if
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
v (:) = aux (:)
deallocate (auxs)
deallocate (aux)

2
PW/src/loc_scdm.f90
View File

@ -140,7 +140,7 @@ implicit none
Gorbt = (Zero,Zero)
DO jbnd = 1, NBands
buffer(:) = abs(dble(orbt(:,jbnd,NKK))) + (Zero,One)*Zero
CALL fwfft( 'CustomWave' , buffer, dfftt )
CALL fwfft( 'Wave' , buffer, dfftt )
DO ig = 1, npwx
Gorbt(ig,jbnd) = buffer(dfftt%nl(ig))
ENDDO

8
PW/src/martyna_tuckerman.f90
View File

@ -202,7 +202,7 @@ CONTAINS
END DO
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
do ig =1, ngm
wg_corr(ig) = omega * REAL(aux(dfftp%nl(ig))) - smooth_coulomb_g( tpiba2*gg(ig))
@ -218,7 +218,7 @@ CONTAINS
ALLOCATE(plot(dfftp%nnr))
filplot = 'wg_corr_r'
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
plot(:) = REAL(aux(:))
call write_wg_on_file(filplot, plot)
@ -229,7 +229,7 @@ CONTAINS
end do
if (gamma_only) aux(dfftp%nlm(1:ngm)) = CONJG( aux(dfftp%nl(1:ngm)) )
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
plot(:) = REAL(aux(:))
call write_wg_on_file(filplot, plot)
@ -240,7 +240,7 @@ CONTAINS
aux(:) = 0.5_dp * aux(:)
aux(dfftp%nlm(1:ngm)) = aux(dfftp%nlm(1:ngm)) + CONJG( aux(dfftp%nl(1:ngm)) )
end if
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
plot(:) = REAL(aux(:))
call write_wg_on_file(filplot, plot)

10
PW/src/mix_rho.f90
View File

@ -457,7 +457,7 @@ SUBROUTINE approx_screening2( drho, rhobest )
!
IF ( gamma_only ) psic(dffts%nlm(:ngm0)) = CONJG( psic(dffts%nl(:ngm0)) )
!
CALL invfft ('Smooth', psic, dffts)
CALL invfft ('Rho', psic, dffts)
!
alpha(:) = REAL( psic(1:dffts%nnr) )
!
@ -492,11 +492,11 @@ SUBROUTINE approx_screening2( drho, rhobest )
!
IF ( gamma_only ) psic(dffts%nlm(:ngm0)) = CONJG( psic(dffts%nl(:ngm0)) )
!
CALL invfft ('Smooth', psic, dffts)
CALL invfft ('Rho', psic, dffts)
!
psic(:dffts%nnr) = psic(:dffts%nnr) * alpha(:)
!
CALL fwfft ('Smooth', psic, dffts)
CALL fwfft ('Rho', psic, dffts)
!
dv(:) = psic(dffts%nl(:ngm0)) * gg(:ngm0) * tpiba2
v(:,1)= psic(dffts%nl(:ngm0)) * gg(:ngm0) / ( gg(:ngm0) + agg0 )
@ -517,11 +517,11 @@ SUBROUTINE approx_screening2( drho, rhobest )
!
IF ( gamma_only ) psic(dffts%nlm(:ngm0)) = CONJG( psic(dffts%nl(:ngm0)) )
!
CALL invfft ('Smooth', psic, dffts)
CALL invfft ('Rho', psic, dffts)
!
psic(:dffts%nnr) = psic(:dffts%nnr) * alpha(:)
!
CALL fwfft ('Smooth', psic, dffts)
CALL fwfft ('Rho', psic, dffts)
!
w(:,m) = w(:,m) + gg(:ngm0) * tpiba2 * psic(dffts%nl(:ngm0))
!

2
PW/src/newd.f90
View File

@ -96,7 +96,7 @@ SUBROUTINE newq(vr,deeq,skip_vltot)
end do
!$omp end parallel do
END IF
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!$omp parallel do default(shared) private(ig)
do ig=1,ngm_l
vaux(ig, is) = psic(dfftp%nl(ngm_s+ig-1))

4
PW/src/potinit.f90
View File

@ -211,7 +211,7 @@ SUBROUTINE potinit()
!
psic(:) = rho%of_r(:,is)
!
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
rho%of_g(:,is) = psic(dfftp%nl(:))
!
@ -228,7 +228,7 @@ SUBROUTINE potinit()
DO is = 1, nspin
if (starting_pot /= 'file') rho%kin_r(:,is) = fact * abs(rho%of_r(:,is)*nspin)**(5.0/3.0)/nspin
psic(:) = rho%kin_r(:,is)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%kin_g(:,is) = psic(dfftp%nl(:))
END DO
!

2
PW/src/pw2casino_write.f90
View File

@ -347,7 +347,7 @@ CONTAINS
! bring rho to G-space
!
aux(:) = cmplx( rho%of_r(:,ispin), 0.d0,kind=DP)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
!
DO nt=1,ntyp
DO ig = 1, ngm

2
PW/src/read_file.f90
View File

@ -341,7 +341,7 @@ SUBROUTINE read_xml_file_internal(withbs)
DO is = 1, nspin
!
psic(:) = rho%of_r(:,is)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%of_g(:,is) = psic(nl(:))
!
END DO

2
PW/src/read_file_new.f90
View File

@ -326,7 +326,7 @@ SUBROUTINE read_xml_file ( )
DO is = 1, nspin
!
psic(:) = rho%of_r(:,is)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%of_g(:,is) = psic(dfftp%nl(:))
!
END DO

8
PW/src/scf_mod.f90
View File

@ -210,7 +210,7 @@ CONTAINS
psic(:) = ( 0.D0, 0.D0 )
psic(dfftp%nl(:)) = rho_s%of_g(:,is)
IF ( gamma_only ) psic(dfftp%nlm(:)) = CONJG( rho_s%of_g(:,is) )
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rho_s%of_r(:,is) = psic(:)
END DO
@ -221,7 +221,7 @@ CONTAINS
psic(:) = ( 0.D0, 0.D0 )
psic(dfftp%nl(:)) = rho_s%kin_g(:,is)
IF ( gamma_only ) psic(dfftp%nlm(:)) = CONJG( rho_s%kin_g(:,is) )
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rho_s%kin_r(:,is) = psic(:)
END DO
end if
@ -327,7 +327,7 @@ CONTAINS
psic(:) = ( 0.D0, 0.D0 )
psic(dfftp%nl(:)) = rhoin%of_g(:,is)
IF ( gamma_only ) psic(dfftp%nlm(:)) = CONJG( rhoin%of_g(:,is) )
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rhoin%of_r(:,is) = psic(:)
END DO
!
@ -339,7 +339,7 @@ CONTAINS
psic(:) = ( 0.D0, 0.D0 )
psic(dfftp%nl(:)) = rhoin%kin_g(:,is)
IF ( gamma_only ) psic(dfftp%nlm(:)) = CONJG( rhoin%kin_g(:,is) )
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rhoin%kin_r(:,is) = psic(:)
END DO
end if

2
PW/src/set_rhoc.f90
View File

@ -90,7 +90,7 @@ subroutine set_rhoc
!
! the core charge in real space
!
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
!
! test on the charge and computation of the core energy
!

2
PW/src/setlocal.f90
View File

@ -88,7 +88,7 @@ SUBROUTINE setlocal
!
! ... aux = potential in G-space . FFT to real space
!
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
!
vltot (:) = DBLE (aux (:) )
!

2
PW/src/stres_cc.f90
View File

@ -58,7 +58,7 @@ subroutine stres_cc (sigmaxcc)
enddo
endif
deallocate (vxc)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
! psic contains now Vxc(G)
!

2
PW/src/stres_har.f90
View File

@ -39,7 +39,7 @@ subroutine stres_har (sigmahar)
call daxpy (dfftp%nnr, 1.d0, rho%of_r (1, is), 1, psic, 2)
enddo
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
! psic contains now the charge density in G space
! the G=0 component is not computed
IF (do_cutoff_2D) THEN

2
PW/src/stres_loc.f90
View File

@ -47,7 +47,7 @@ subroutine stres_loc (sigmaloc)
call daxpy (dfftp%nnr, 1.d0, rho%of_r (1, is), 1, psic, 2)
enddo
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
! psic contains now the charge density in G space
if (gamma_only) then
fact = 2.d0

8
PW/src/sum_band.f90
View File

@ -181,7 +181,7 @@ SUBROUTINE sum_band()
!
DO is = 1, nspin
psic(:) = rho%of_r(:,is)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%of_g(:,is) = psic(dfftp%nl(:))
END DO
!
@ -195,7 +195,7 @@ SUBROUTINE sum_band()
psic(:) = ( 0.D0, 0.D0 )
psic(dfftp%nl(:)) = rho%of_g(:,is)
IF ( gamma_only ) psic(dfftp%nlm(:)) = CONJG( rho%of_g(:,is) )
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rho%of_r(:,is) = psic(:)
END DO
!
@ -208,7 +208,7 @@ SUBROUTINE sum_band()
CALL mp_sum( rho%kin_r, inter_bgrp_comm )
DO is = 1, nspin
psic(:) = rho%kin_r(:,is)
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
rho%kin_g(:,is) = psic(dfftp%nl(:))
END DO
!
@ -218,7 +218,7 @@ SUBROUTINE sum_band()
psic(:) = ( 0.D0, 0.D0 )
psic(dfftp%nl(:)) = rho%kin_g(:,is)
IF ( gamma_only ) psic(dfftp%nlm(:)) = CONJG( rho%kin_g(:,is) )
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
rho%kin_r(:,is) = psic(:)
END DO
!

2
PW/src/update_pot.f90
View File

@ -588,7 +588,7 @@ SUBROUTINE extrapolate_charge( dirname, rho_extr )
!
psic(:) = rho%of_r(:,is)
!
CALL fwfft ('Dense', psic, dfftp)
CALL fwfft ('Rho', psic, dfftp)
!
rho%of_g(:,is) = psic(dfftp%nl(:))
!

4
PW/src/us_exx.f90
View File

@ -1035,7 +1035,7 @@ MODULE us_exx
DO ibnd = ibnd_loop_start,ibnd_end,2
h_ibnd = h_ibnd + 1
phi(:) = exxbuff(:,h_ibnd,ikq)
CALL fwfft ('CustomWave', phi, dfftt)
CALL fwfft ('Wave', phi, dfftt)
IF (ibnd < ibnd_end) THEN
! two ffts at the same time
DO j = 1, ngkq(ikq)
@ -1053,7 +1053,7 @@ MODULE us_exx
ELSE
DO ibnd = ibnd_start,ibnd_end
phi(:) = exxbuff(:,ibnd,ikq)
CALL fwfft ('CustomWave', phi, dfftt)
CALL fwfft ('Wave', phi, dfftt)
DO j = 1, ngkq(ikq)
evcq(j, ibnd) = phi(dfftt%nl(igkq(j)))
ENDDO

8
PW/src/v_of_rho.f90
View File

@ -656,7 +656,7 @@ SUBROUTINE v_h( rhog, ehart, charge, v )
!
! ... transform hartree potential to real space
!
CALL invfft ('Dense', aux, dfftp)
CALL invfft ('Rho', aux, dfftp)
!
! ... add hartree potential to the xc potential
!
@ -1091,7 +1091,7 @@ SUBROUTINE v_h_of_rho_r( rhor, ehart, charge, v )
ALLOCATE( aux( dfftp%nnr ) )
DO is = 1, nspin
aux(:) = CMPLX(rhor( : , is ),0.D0,kind=dp)
CALL fwfft ('Dense', aux, dfftp)
CALL fwfft ('Rho', aux, dfftp)
rhog(:,is) = aux(dfftp%nl(:))
END DO
DEALLOCATE( aux )
@ -1140,7 +1140,7 @@ SUBROUTINE gradv_h_of_rho_r( rho, gradv )
ALLOCATE( rhoaux( dfftp%nnr ) )
rhoaux( : ) = CMPLX( rho( : ), 0.D0, KIND=dp )
!
CALL fwfft('Dense', rhoaux, dfftp)
CALL fwfft('Rho', rhoaux, dfftp)
!
! ... Compute total potential in G space
!
@ -1185,7 +1185,7 @@ SUBROUTINE gradv_h_of_rho_r( rho, gradv )
!
! ... bring back to R-space, (\grad_ipol a)(r) ...
!
CALL invfft ('Dense', gaux, dfftp)
CALL invfft ('Rho', gaux, dfftp)
!
gradv(ipol,:) = REAL( gaux(:) )
!

2
TDDFPT/src/lr_addusddens.f90
View File

@ -130,7 +130,7 @@ SUBROUTINE lr_addusddens (drhoscf, dbecsum)
psic(dfftp%nl(ig)) = aux(ig,is)
ENDDO
!
CALL invfft ('Dense', psic, dfftp)
CALL invfft ('Rho', psic, dfftp)
!
DO ir = 1, dfftp%nnr
drhoscf(ir,is) = drhoscf(ir,is) + psic(ir)

24
TDDFPT/src/lr_exx_kernel.f90
View File

@ -164,7 +164,7 @@ SUBROUTINE lr_exx_apply_revc_int(psi, ibnd, nbnd, ik)
!
! To g-space
!
CALL fwfft ('CustomWave', tempphic(:,1), dfftt)
CALL fwfft ('Wave', tempphic(:,1), dfftt)
!
! Now separate the two bands and apply the correct nl mapping
!
@ -187,7 +187,7 @@ SUBROUTINE lr_exx_apply_revc_int(psi, ibnd, nbnd, ik)
!
! To g-space
!
CALL fwfft ('CustomWave', tempphic(:,1), dfftt)
CALL fwfft ('Wave', tempphic(:,1), dfftt)
!
! Correct the nl mapping for the two grids.
!
@ -803,7 +803,7 @@ FUNCTION k1d_term_gamma(w1, w2, psi, fac_in, ibnd) RESULT (psi_int)
&AIMAG(red_revc0(1:nnr_,ibnd2-1,1)), kind=DP )
ENDIF
!
CALL fwfft ('Custom', pseudo_dens_c, dfftt)
CALL fwfft ('Rho', pseudo_dens_c, dfftt)
!
! hartree contribution is computed in reciprocal space
!
@ -818,7 +818,7 @@ FUNCTION k1d_term_gamma(w1, w2, psi, fac_in, ibnd) RESULT (psi_int)
!
! and transformed back to real space
!
CALL invfft ('Custom', vhart (:, is), dfftt)
CALL invfft ('Rho', vhart (:, is), dfftt)
!
ENDDO
!
@ -873,7 +873,7 @@ FUNCTION k1d_term_k(w1, psi, fac_in, ibnd, ik,ikq) RESULT (psi_int)
pseudo_dens_c(:) = CONJG(red_revc0(:,ibnd,ikq))*&
&red_revc0(:,ibnd2,k2q(ik))/omega
!
CALL fwfft ('Smooth', pseudo_dens_c, dffts)
CALL fwfft ('Rho', pseudo_dens_c, dffts)
!
! hartree contribution is computed in reciprocal space
!
@ -884,7 +884,7 @@ FUNCTION k1d_term_k(w1, psi, fac_in, ibnd, ik,ikq) RESULT (psi_int)
!
! and transformed back to real space
!
CALL invfft ('Smooth', vhart (:, is), dffts)
CALL invfft ('Rho', vhart (:, is), dffts)
!
ENDDO
!
@ -948,7 +948,7 @@ FUNCTION k2d_term_gamma(w1, w2, psi, fac_in, ibnd) RESULT (psi_int)
& w2*AIMAG(psi(1:nnr_))*AIMAG(red_revc0(1:nnr_,ibnd2-1,1)), kind=DP )
ENDIF
!
CALL fwfft ('Custom', pseudo_dens_c, dfftt)
CALL fwfft ('Rho', pseudo_dens_c, dfftt)
!
! hartree contribution is computed in reciprocal space
!
@ -961,7 +961,7 @@ FUNCTION k2d_term_gamma(w1, w2, psi, fac_in, ibnd) RESULT (psi_int)
!
! and transformed back to real space
!
CALL invfft ('Custom', vhart (:, is), dfftt)
CALL invfft ('Rho', vhart (:, is), dfftt)
!
ENDDO
!
@ -1012,7 +1012,7 @@ FUNCTION k2d_term_k(w1, psi, fac_in, ibnd, ik, ikq) RESULT (psi_int)
!
pseudo_dens_c(:) = CONJG(psi(:))*red_revc0(:,ibnd2,k2q(ik))/omega
!
CALL fwfft ('Smooth', pseudo_dens_c, dffts)
CALL fwfft ('Rho', pseudo_dens_c, dffts)
!
! hartree contribution is computed in reciprocal space
!
@ -1023,7 +1023,7 @@ FUNCTION k2d_term_k(w1, psi, fac_in, ibnd, ik, ikq) RESULT (psi_int)
!
! and transformed back to real space
!
CALL invfft ('Smooth', vhart (:, is), dffts)
CALL invfft ('Rho', vhart (:, is), dffts)
!
ENDDO
!
@ -1072,7 +1072,7 @@ SUBROUTINE invfft_orbital_custom_gamma(orbital, ibnd, nbnd, npwt, dfftt)
!
ENDIF
!
CALL invfft ('CustomWave', psic, dfftt)
CALL invfft ('Wave', psic, dfftt)
!
RETURN
!
@ -1094,7 +1094,7 @@ SUBROUTINE fwfft_orbital_custom_gamma(orbital, ibnd, nbnd, npwt, dfftt)
! Counters
INTEGER :: j
!
CALL fwfft ('CustomWave', psic(:), dfftt)
CALL fwfft ('Wave', psic(:), dfftt)
!
IF (ibnd < nbnd) THEN
!