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

More cft/cft3s => fwfft/invfft conversion. May or may not work. 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@7020 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2010-08-27 08:34:27 +00:00
parent 987f75d2bb
commit be2f483311
17 changed files with 116 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
PP/add_shift_cc.f90
View File

@ -16,8 +16,9 @@ SUBROUTINE add_shift_cc (shift_cc)
USE uspp_param, ONLY: upf
USE ions_base, ONLY: nat, ntyp => nsp, ityp, tau
USE cell_base, ONLY: alat, omega, tpiba, tpiba2
USE gvect, ONLY: ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
nrxx, nl, g, gg, ngl, gl, igtongl
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY : fwfft
USE gvect, ONLY: ngm, gstart, nrxx, nl, g, gg, ngl, gl, igtongl
USE ener, ONLY: etxc, vtxc
USE lsda_mod, ONLY: nspin
USE scf, ONLY: rho, rho_core, rhog_core
@ -74,7 +75,7 @@ SUBROUTINE add_shift_cc (shift_cc)
ENDDO
ENDIF
DEALLOCATE (vxc)
CALL cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, - 1)
CALL fwfft ('Dense', psic, dfftp)
!
! psic contains now Vxc(G)
!

29
PP/add_shift_lc.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2010 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,
@ -8,12 +8,13 @@
!
!----------------------------------------------------------------------
SUBROUTINE add_shift_lc (nat, tau, ityp, alat, omega, ngm, ngl, &
igtongl, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, g, rho, nl, &
nspin, gstart, gamma_only, vloc, shift_lc)
igtongl, nrxx, g, rho, nl, nspin, gstart, gamma_only, vloc, shift_lc)
!----------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY : fwfft
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
@ -21,11 +22,10 @@ SUBROUTINE add_shift_lc (nat, tau, ityp, alat, omega, ngm, ngl, &
!
! first the dummy variables
!
INTEGER :: nat, ngm, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, nspin, &
INTEGER :: nat, ngm, nrxx, nspin, &
ngl, gstart, igtongl (ngm), nl (ngm), ityp (nat)
! input: the number of atoms in the cell
! input: the number of G vectors
! input: FFT dimensions
! input: number of spin polarizations
! input: the number of shells
! input: correspondence G <-> shell of G
@ -50,20 +50,23 @@ SUBROUTINE add_shift_lc (nat, tau, ityp, alat, omega, ngm, ngl, &
! counter on G vectors
! counter on atoms
real(DP), ALLOCATABLE :: aux (:,:), shift_(:)
real(DP), ALLOCATABLE :: shift_(:)
complex(DP), ALLOCATABLE :: aux (:)
! auxiliary space for FFT
real(DP) :: arg, fact
!
! contribution to the force from the local part of the bare potential
! F_loc = Omega \Sum_G n*(G) d V_loc(G)/d R_i
!
ALLOCATE (aux(2, nrxx), shift_(nat) )
ALLOCATE (aux(nrxx), shift_(nat) )
shift_(:) = 0.d0
aux(1,:) = rho(:,1)
IF (nspin==2) aux(1,:) = aux(1,:) + rho(:,2)
aux(2,:) = 0.d0
CALL cft3 (aux, nr1, nr2, nr3, nrx1, nrx2, nrx3, - 1)
IF (nspin==2) THEN
aux(:) = CMPLX ( rho(:,1)+rho(:,2), 0.0_dp, KIND=dp )
ELSE
aux(:) = CMPLX ( rho(:,1), 0.0_dp, KIND=dp )
END IF
CALL fwfft ('Dense', aux, dfftp)
!
! aux contains now n(G)
!
@ -74,13 +77,13 @@ SUBROUTINE add_shift_lc (nat, tau, ityp, alat, omega, ngm, ngl, &
ENDIF
DO na = 1, nat
! contribution from G=0 is not zero but should be counted only once
IF (gstart==2) shift_(na)=vloc(igtongl(1),ityp(na))*aux(1,nl(1))/ fact
IF (gstart==2) shift_(na) = vloc(igtongl(1),ityp(na)) * DBLE (aux(nl(1))) / fact
DO ig = gstart, ngm
arg = (g (1, ig) * tau (1, na) + g (2, ig) * tau (2, na) + &
g (3, ig) * tau (3, na) ) * tpi
shift_ ( na) = shift_ (na) + &
vloc (igtongl (ig), ityp (na) ) * &
(cos (arg) * aux(1,nl(ig)) - sin (arg) * aux(2,nl(ig)) )
(cos (arg) * DBLE (aux(nl(ig))) - sin (arg) * AIMAG (aux(nl(ig))) )
ENDDO
shift_ (na) = fact * shift_ (na) * omega
ENDDO

5
PP/chdens.f90
View File

@ -23,11 +23,12 @@ SUBROUTINE chdens (filplot,plot_num)
USE cell_base
USE ions_base, ONLY : nat, ityp, atm, ntyp => nsp, tau, zv
USE lsda_mod, ONLY: nspin
USE fft_base, ONLY: grid_scatter, dfftp
USE fft_interfaces, ONLY : fwfft
USE gvect
USE gsmooth
USE wavefunctions_module, ONLY: psic
USE io_files, ONLY: nd_nmbr
USE fft_base, ONLY: grid_scatter
USE printout_base, ONLY: title
USE control_flags, ONLY: gamma_only
@ -373,7 +374,7 @@ SUBROUTINE chdens (filplot,plot_num)
#else
psic(:) = cmplx(rhor(:), 0.d0,kind=DP)
#endif
CALL cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, -1)
CALL fwfft ('Dense', psic, dfftp)
!
! we store the fourier components in the array rhog
!

9
PP/compute_sigma_avg.f90
View File

@ -19,7 +19,7 @@ USE uspp_param, ONLY : upf, nh, nhm
USE wvfct, ONLY : nbnd, npwx, npw, igk
USE wavefunctions_module, ONLY : evc, psic_nc
USE klist, ONLY : nks, xk
USE gvect, ONLY : g,gg,nr1,nr2,nr3,nrx1,nrx2,nrx3,nrxx
USE gvect, ONLY : g,gg,nr1,nr2,nr3,nrxx
USE gsmooth, ONLY : nls, nlsm, nr1s, nr2s, nr3s, &
nrx1s, nrx2s, nrx3s, nrxxs, doublegrid
USE scf, ONLY : rho
@ -27,6 +27,7 @@ USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE mp_global, ONLY : me_pool, intra_pool_comm
USE mp, ONLY : mp_sum
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : invfft
IMPLICIT NONE
@ -114,7 +115,7 @@ DO ibnd = 1, nbnd
psic_nc(nls(igk(ig)), 2)=evc(ig+npwx,ibnd)
ENDDO
DO ipol=1,npol
CALL cft3s (psic_nc(1,ipol), nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
CALL invfft ('Wave', psic_nc(:,ipol), dffts)
ENDDO
!
! Calculate the three components of the magnetization
@ -156,8 +157,8 @@ DO ibnd = 1, nbnd
(0.d0,1.d0)*evc(npwi:npwf,ibnd)
dfy(nls(igk(1:npw))) = (xk(2,ik)+g(2,igk(1:npw)))*tpiba* &
(0.d0,1.d0)*evc(npwi:npwf,ibnd)
CALL cft3s( dfx, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2 )
CALL cft3s( dfy, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2 )
CALL invfft ('Wave', dfx, dffts)
CALL invfft ('Wave', dfy, dffts)
DO i = 1, nr1s
xx = (i-1)*dx - x0
DO j = 1, nr2s

2
PP/do_initial_state.f90
View File

@ -114,7 +114,7 @@ SUBROUTINE do_initial_state (excite)
! ... The local contribution
!
CALL add_shift_lc( nat, tau, ityp, alat, omega, ngm, ngl, igtongl, &
nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, g, rho%of_r, nl, nspin, &
nrxx, g, rho%of_r, nl, nspin, &
gstart, gamma_only, vloc, shift_lc )
!
! ... The NLCC contribution

18
PP/elf.f90
View File

@ -30,10 +30,10 @@ SUBROUTINE do_elf (elf)
USE kinds, ONLY: DP
USE constants, ONLY: pi
USE cell_base, ONLY: omega, tpiba, tpiba2
USE gvect, ONLY: nr1,nr2,nr3, nrx1,nrx2,nrx3, nrxx, gcutm, ecutwfc, &
dual, g, ngm, nl, nlm
USE gsmooth, ONLY : nls, nlsm, nr1s, nr2s, nr3s, ngms, &
nrx1s, nrx2s, nrx3s, nrxxs, doublegrid
USE fft_base, ONLY: dffts, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY: nrxx, gcutm, ecutwfc, dual, g, ngm, nl, nlm
USE gsmooth, ONLY : nls, nlsm, ngms, nrxxs, doublegrid
USE io_files, ONLY: iunwfc, nwordwfc
USE klist, ONLY: nks, xk
USE lsda_mod, ONLY: nspin
@ -88,7 +88,7 @@ SUBROUTINE do_elf (elf)
conjg ( evc (i, ibnd) )
ENDIF
ENDDO
CALL cft3s (aux, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
CALL invfft ('Wave', aux, dffts)
DO i = 1, nrxxs
kkin(i) = kkin(i) + w1 * (dble(aux(i))**2 + aimag(aux(i))**2)
ENDDO
@ -122,7 +122,7 @@ SUBROUTINE do_elf (elf)
CALL sym_rho_init ( gamma_only )
!
aux(:) = cmplx ( kkin (:), 0.0_dp, kind=dp)
CALL cft3s (aux, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, -1)
CALL fwfft ('Smooth', aux, dffts)
ALLOCATE (aux2(ngm))
aux2(:) = aux(nl(:))
!
@ -133,7 +133,7 @@ SUBROUTINE do_elf (elf)
aux(:) = (0.0_dp, 0.0_dp)
aux(nl(:)) = aux2(:)
DEALLOCATE (aux2)
CALL cft3 (aux, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', aux, dfftp)
kkin (:) = dble(aux(:))
!
ENDIF
@ -152,7 +152,7 @@ SUBROUTINE do_elf (elf)
ENDDO
!
aux(:) = cmplx( rho%of_r(:, 1), 0.d0 ,kind=DP)
CALL cft3 (aux, nr1, nr2, nr3, nrx1, nrx2, nrx3, - 1)
CALL fwfft ('Dense', aux, dfftp)
!
DO j = 1, 3
aux2(:) = (0.d0,0.d0)
@ -165,7 +165,7 @@ SUBROUTINE do_elf (elf)
ENDDO
ENDIF
CALL cft3 (aux2, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', aux2, dffts)
DO i = 1, nrxx
tbos (i) = tbos (i) + dble(aux2(i))**2
ENDDO

17
PP/local_dos.f90
View File

@ -27,10 +27,10 @@ SUBROUTINE local_dos (iflag, lsign, kpoint, kband, spin_component, &
USE cell_base, ONLY : omega, tpiba2
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE ener, ONLY : ef
USE gvect, ONLY : nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, &
nl, ngm, g, ecutwfc
USE gsmooth, ONLY : nls, nlsm, nr1s, nr2s, nr3s, &
nrx1s, nrx2s, nrx3s, nrxxs, doublegrid
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : nrxx, nl, ngm, g, ecutwfc
USE gsmooth, ONLY : nls, nlsm, nrxxs, doublegrid
USE klist, ONLY : lgauss, degauss, ngauss, nks, wk, xk, nkstot
USE lsda_mod, ONLY : lsda, nspin, current_spin, isk
USE scf, ONLY : rho
@ -175,8 +175,7 @@ SUBROUTINE local_dos (iflag, lsign, kpoint, kband, spin_component, &
psic_nc(nls(igk(ig)),2)=evc(ig+npwx,ibnd)
ENDDO
DO ipol=1,npol
CALL cft3s (psic_nc(1,ipol),nr1s,nr2s,nr3s, &
nrx1s,nrx2s,nrx3s,2)
CALL invfft ('Wave', psic_nc(:,ipol), dffts)
ENDDO
ELSE
psic(1:nrxxs) = (0.d0,0.d0)
@ -188,7 +187,7 @@ SUBROUTINE local_dos (iflag, lsign, kpoint, kband, spin_component, &
psic (nlsm(igk (ig) ) ) = conjg(evc (ig, ibnd))
ENDDO
ENDIF
CALL cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
CALL invfft ('Wave', psic, dffts)
ENDIF
w1 = wg (ibnd, ik) / omega
!
@ -407,14 +406,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 cft3s (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, -1)
CALL fwfft ('Dense', psic, dfftp)
rho%of_g(:,1) = psic(nl(:))
!
CALL sym_rho (1, rho%of_g)
!
psic(:) = (0.0_dp, 0.0_dp)
psic(nl(:)) = rho%of_g(:,1)
CALL cft3s (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
dos(:) = dble(psic(:))
!
RETURN

13
PP/local_dos1d.f90
View File

@ -13,10 +13,13 @@ SUBROUTINE local_dos1d (ik, kband, plan)
!
! calculates |psi|^2 for band kband at point ik
!
USE kinds, ONLY: dp
USE cell_base, ONLY: omega
USE ions_base, ONLY: nat, ntyp=>nsp, ityp
USE gvect
USE gsmooth
USE fft_base, ONLY: dffts, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : nrxx, nr3
USE gsmooth, ONLY : nrxxs, nls, doublegrid
USE lsda_mod, ONLY: current_spin
USE uspp, ONLY: becsum, indv, nhtol, nhtoj
USE uspp_param, ONLY: upf, nh, nhm
@ -88,7 +91,7 @@ SUBROUTINE local_dos1d (ik, kband, plan)
psic_nc (nls (igk (ig) ), 2 ) = evc (ig+npwx, kband)
ENDDO
DO ipol=1,npol
CALL cft3s (psic_nc(1,ipol), nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
CALL invfft ('Wave', psic_nc(:,ipol), dffts)
ENDDO
w1 = wg (kband, ik) / omega
@ -103,7 +106,7 @@ SUBROUTINE local_dos1d (ik, kband, plan)
DO ig = 1, npw
psic (nls (igk (ig) ) ) = evc (ig, kband)
ENDDO
CALL cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
CALL invfft ('Wave', psic, dffts)
w1 = wg (kband, ik) / omega
DO ir = 1, nrxxs
@ -212,7 +215,7 @@ SUBROUTINE local_dos1d (ik, kband, plan)
DO ir = 1, nrxx
prho (ir) = cmplx(aux (ir), 0.d0,kind=DP)
ENDDO
CALL cft3 (prho, nr1, nr2, nr3, nrx1, nrx2, nrx3, - 1)
CALL fwfft ('Dense', 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.

8
PP/local_dos_mag.f90
View File

@ -17,9 +17,10 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux)
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE cell_base, ONLY : omega,tpiba2
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : invfft
USE gvect, ONLY : nrxx, ngm, g, ecutwfc
USE gsmooth, ONLY : nls, nr1s, nr2s, nr3s, &
nrx1s, nrx2s, nrx3s, nrxxs, doublegrid
USE gsmooth, ONLY : nls, nrxxs, doublegrid
USE klist, ONLY : nks, xk
USE scf, ONLY : rho
USE io_files, ONLY : iunwfc, nwordwfc
@ -83,8 +84,7 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux)
psic_nc(nls(igk(ig)),2)=evc(ig+npwx,ibnd)
ENDDO
DO ipol=1,npol
CALL cft3s (psic_nc(1,ipol), nr1s, nr2s, nr3s, nrx1s, &
nrx2s, nrx3s, 2)
CALL invfft ('Wave', psic_nc(:,ipol), dffts)
ENDDO
IF (spin_component==1) THEN
DO ir = 1,nrxxs

14
PP/projwfc.f90
View File

@ -2966,11 +2966,12 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox
USE wavefunctions_module, ONLY: evc, psic
USE wavefunctions_module, ONLY: psic_nc
USE io_files, ONLY : iunwfc, nwordwfc
USE scf, ONLY : rho
USE scf, ONLY : rho
USE projections_ldos
USE fft_base, ONLY: grid_scatter
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
USE fft_base, ONLY : grid_scatter, dfftp
USE fft_interfaces, ONLY : invfft
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
!
!
IMPLICIT NONE
@ -3159,8 +3160,7 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox
ENDDO
raux=0._DP
DO ipol=1,npol
CALL cft3 (psic_nc(1,ipol),nr1,nr2,nr3, &
nrx1,nrx2,nrx3,1)
CALL invfft ('Dense', psic_nc(:,ipol), dfftp)
raux(:) = raux(:)+dble( psic_nc(:,ipol) )**2 &
+ aimag( psic_nc(:,ipol) )**2
ENDDO
@ -3176,7 +3176,7 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox
caux (nlm(igk (ig) ) ) = conjg(evc (ig, ibnd))
ENDDO
ENDIF
CALL cft3 (caux, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', caux, dfftp)
!
raux(:) = dble( caux(:) )**2 + aimag( caux(:) )**2
!

13
PP/punch_plot.f90
View File

@ -24,7 +24,9 @@ SUBROUTINE punch_plot (filplot, plot_num, sample_bias, z, dz, &
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, zv, atm
USE printout_base, ONLY : title
USE extfield, ONLY : tefield, dipfield
USE gvect
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : nrxx, gcutm, dual, ecutwfc, nr1,nr2,nr3,nrx1,nrx2,nrx3
USE klist, ONLY : nks, nkstot, xk
USE lsda_mod, ONLY : nspin, current_spin
USE ener, ONLY : ehart
@ -272,8 +274,9 @@ SUBROUTINE polarization ( spin_component, ipol, epsilon, raux )
!
USE kinds, ONLY : DP
USE constants, ONLY : fpi
USE gvect, ONLY: nr1, nr2, nr3, nrx1, nrx2, nrx3, nl, nlm, &
ngm, nrxx, gstart, g, gg
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY: nl, nlm, ngm, nrxx, gstart, g, gg
USE lsda_mod, ONLY : nspin
USE scf, ONLY: rho
USE control_flags, ONLY : gamma_only
@ -300,7 +303,7 @@ SUBROUTINE polarization ( spin_component, ipol, epsilon, raux )
!
! transform to G space
!
CALL cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, - 1)
CALL fwfft ('Dense', psic, dfftp)
!
IF (gstart == 2) psic (1) = (epsilon - 1.d0) / fpi
DO ig = gstart, ngm
@ -309,7 +312,7 @@ SUBROUTINE polarization ( spin_component, ipol, epsilon, raux )
IF (gamma_only) psic (nlm(ig) ) = conjg ( psic (nl (ig) ) )
ENDDO
!
CALL cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
!
raux (:) = dble (psic (:) )
!

6
PP/pw2casino_write.f90
View File

@ -14,7 +14,9 @@ SUBROUTINE write_casino_wfn(gather,blip,multiplicity,binwrite,single_precision_b
USE printout_base, ONLY: title ! title of the run
USE constants, ONLY: tpi, e2
USE ener, ONLY: ewld, ehart, etxc, vtxc, etot, etxcc, demet, ef
USE gvect, ONLY: ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY : fwfft
USE gvect, ONLY: ngm, gstart, &
nrxx, g, gg, ecutwfc, gcutm, nl, nlm, igtongl
USE klist , ONLY: nks, nelec, xk, wk, degauss, ngauss
USE lsda_mod, ONLY: lsda, nspin
@ -341,7 +343,7 @@ CONTAINS
! bring rho to G-space
!
aux(:) = cmplx( rho%of_r(:,ispin), 0.d0,kind=DP)
CALL cft3(aux,nr1,nr2,nr3,nrx1,nrx2,nrx3,-1)
CALL fwfft ('Dense', aux, dfftp)
!
DO nt=1,ntyp
DO ig = 1, ngm

14
PP/pw2gw.f90
View File

@ -103,8 +103,9 @@ SUBROUTINE compute_gw( use_gmaps )
USE symm_base, ONLY : s, nsym
USE wvfct, ONLY : npw, npwx, nbnd, igk, g2kin, wg, et
USE control_flags, ONLY : gamma_only
USE gvect, ONLY : ngm, g, gg, ig_l2g, ecutwfc, nl, nrx1, nrx2, nrx3, &
nr1, nr2, nr3, nrxx
USE gvect, ONLY : ngm, g, gg, ig_l2g, ecutwfc, nl, nr1, nr2, nr3, nrxx
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE klist , ONLY : nks, xk, wk
USE lsda_mod, ONLY : nspin
USE io_files, ONLY : nwordwfc, iunwfc
@ -749,15 +750,15 @@ SUBROUTINE compute_gw( use_gmaps )
psic(nl(igk(ig))) = evc(ig,iband1)
ENDDO
CALL cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
vxcdiag = 0.0d0
!norma = 0.0d0
DO ir = 1, nrxx
vxcdiag = vxcdiag + vxc(ir,nspin) * &
( dble(psic (ir) ) **2 + aimag(psic (ir) ) **2)
! norma = norma + ( DBLE(psic (ir) ) **2 + AIMAG(psic (ir) ) **2) / nrxx
! norma = norma + ( DBLE(psic (ir) ) **2 + AIMAG(psic (ir) ) **2) / (nr1*nr2*nr3)
ENDDO
vxcdiag = vxcdiag * rytoev / (nrx1*nrx2*nrx3) !nrxx
vxcdiag = vxcdiag * rytoev / (nr1*nr2*nr3) ! PG: this is the correct integral - 27/8/2010
CALL mp_sum( vxcdiag ) !, intra_pool_comm )
! ONLY FOR DEBUG!
!IF (norma /= 1.0) THEN
@ -842,8 +843,7 @@ SUBROUTINE write_gmaps ( kunit)
USE io_global, ONLY : stdout
USE cell_base, ONLY : at, bg, tpiba2, alat
USE ions_base, ONLY : atm, nat
USE gvect, ONLY : ngm, ngm_g, ig_l2g, ig1, ig2, ig3, ecutwfc, &
nr1, nr2, nr3, g
USE gvect, ONLY : ngm, ngm_g, ig_l2g, ig1, ig2, ig3, ecutwfc, g
USE lsda_mod, ONLY : nspin, isk
USE ions_base, ONLY : ntyp => nsp, tau, ityp
USE wvfct, ONLY : nbnd, npw, npwx, et, g2kin

22
PP/pw2wannier90.f90
View File

@ -560,7 +560,6 @@ SUBROUTINE read_nnkp
INTEGER numk, i, j
INTEGER, ALLOCATABLE :: ig_check(:,:)
real(DP) :: xx(3), xnorm, znorm, coseno
CHARACTER(len=80) :: line1, line2
LOGICAL :: have_nnkp
IF (ionode) THEN ! Read nnkp file on ionode only
@ -825,7 +824,9 @@ SUBROUTINE compute_mmn
USE wvfct, ONLY : nbnd, npw, npwx, igk, g2kin
USE control_flags, ONLY : gamma_only
USE wavefunctions_module, ONLY : evc, psic, psic_nc
USE gsmooth, ONLY: nls, nlsm, nrxxs, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : fwfft, invfft
USE gsmooth, ONLY : nls, nlsm, nrxxs
USE klist, ONLY : nkstot, xk
USE io_files, ONLY : nwordwfc, iunwfc
USE io_files, ONLY : find_free_unit
@ -1030,7 +1031,7 @@ SUBROUTINE compute_mmn
! compute the phase
phase(:) = (0.d0,0.d0)
IF ( ig_(ik,ib)>0) phase( nls(ig_(ik,ib)) ) = (1.d0,0.d0)
CALL cft3s (phase, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
CALL invfft ('Wave', phase, dffts)
!
! USPP
!
@ -1109,18 +1110,18 @@ SUBROUTINE compute_mmn
istart=(ipol-1)*npwx+1
iend=istart+npw-1
psic_nc(nls (igk (1:npw) ),ipol ) = evc(istart:iend, m)
CALL cft3s (psic_nc(1,ipol), nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
CALL invfft ('Wave', psic_nc(:,ipol), dffts)
psic_nc(1:nrxxs,ipol) = psic_nc(1:nrxxs,ipol) * phase(1:nrxxs)
CALL cft3s (psic_nc(1,ipol), nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, -2)
CALL fwfft ('Wave', psic_nc(:,ipol), dffts)
aux_nc(1:npwq,ipol) = psic_nc(nls (igkq(1:npwq) ),ipol )
ENDDO
ELSE
psic(:) = (0.d0, 0.d0)
psic(nls (igk (1:npw) ) ) = evc (1:npw, m)
IF(gamma_only) psic(nlsm(igk (1:npw) ) ) = conjg(evc (1:npw, m))
CALL cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
CALL invfft ('Wave', psic, dffts)
psic(1:nrxxs) = psic(1:nrxxs) * phase(1:nrxxs)
CALL cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, -2)
CALL fwfft ('Wave', psic, dffts)
aux(1:npwq) = psic(nls (igkq(1:npwq) ) )
ENDIF
IF(gamma_only) THEN
@ -1496,7 +1497,8 @@ SUBROUTINE write_plot
USE klist, ONLY : nkstot, xk
USE gvect, ONLY : g, ngm, ecutwfc
USE cell_base, ONLY : tpiba2
USE fft_base, ONLY : cgather_smooth
USE fft_base, ONLY : cgather_smooth, dffts
USE fft_interfaces, ONLY : invfft
USE noncollin_module,ONLY : noncolin
IMPLICIT NONE
@ -1564,7 +1566,7 @@ SUBROUTINE write_plot
psic(:) = (0.d0, 0.d0)
psic(nls (igk (1:npw) ) ) = evc (1:npw, ibnd)
IF (gamma_only) psic(nlsm(igk (1:npw) ) ) = conjg(evc (1:npw, ibnd))
CALL cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
CALL invfft ('Wave', psic, dffts)
IF (reduce_unk) pos=0
#ifdef __PARA
CALL cgather_smooth(psic,psic_all)
@ -2030,7 +2032,7 @@ SUBROUTINE wan2sic
USE io_files, ONLY : iunwfc, iunatsicwfc, nwordwfc, nwordwann
USE cell_base, ONLY : omega, tpiba2
USE gvect, ONLY : g, ngm, ecutwfc
USE gsmooth, ONLY: nls, nrxxs, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s
USE gsmooth, ONLY: nls, nrxxs
USE wavefunctions_module, ONLY : evc, psic
USE wvfct, ONLY : nbnd, npwx, npw, igk, g2kin
USE klist, ONLY : nkstot, xk, wk

12
PP/stm.f90
View File

@ -23,7 +23,9 @@ SUBROUTINE stm (wf, sample_bias, z, dz, stmdos)
USE constants, ONLY: tpi, rytoev
USE io_global, ONLY : stdout
USE cell_base, ONLY: tpiba2, tpiba, omega, at, alat
USE gvect, ONLY: nrx1, nrx2, nrx3, nr1, nr2, nr3, ngm, g, ecutwfc, &
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY: nrx1, nrx2, nrx3, ngm, g, ecutwfc, &
nl, nlm, nrxx
USE klist, ONLY: xk, lgauss, degauss, ngauss, wk, nks, nelec
USE ener, ONLY: ef
@ -189,7 +191,7 @@ SUBROUTINE stm (wf, sample_bias, z, dz, stmdos)
ENDDO
ENDIF
CALL cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
DO ir = 1, nrxx
rho%of_r (ir, 1) = rho%of_r (ir, 1) + w1* dble( psic(ir) )**2 + &
w2*aimag( psic(ir) )**2
@ -211,7 +213,7 @@ SUBROUTINE stm (wf, sample_bias, z, dz, stmdos)
psic(nl(igk(ig))) = evc(ig,ibnd)
ENDDO
CALL cft3 (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
DO ir = 1, nrxx
rho%of_r (ir, 1) = rho%of_r (ir, 1) + w1 * &
( dble(psic (ir) ) **2 + aimag(psic (ir) ) **2)
@ -230,12 +232,12 @@ SUBROUTINE stm (wf, sample_bias, z, dz, stmdos)
CALL sym_rho_init (gamma_only)
!
psic(:) = cmplx ( rho%of_r(:,1), 0.0_dp, kind=dp)
CALL cft3s (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, -1)
CALL fwfft ('Dense', psic, dfftp)
rho%of_g(:,1) = psic(nl(:))
CALL sym_rho (1, rho%of_g)
psic(:) = (0.0_dp, 0.0_dp)
psic(nl(:)) = rho%of_g(:,1)
CALL cft3s (psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1)
CALL invfft ('Dense', psic, dfftp)
rho%of_r(:,1) = dble(psic(:))
ENDIF
#ifdef __PARA

16
PP/sym_band.f90
View File

@ -463,7 +463,9 @@ SUBROUTINE rotate_psi(evc,evcr,s,ftau,gk,nl,igk,nr1,nr2,nr3, &
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE fft_base, ONLY : cgather_sym, cscatter_sym
USE fft_base, ONLY : cgather_sym, cscatter_sym, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
IMPLICIT NONE
INTEGER :: nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, ngm, npw, nbnd
@ -491,7 +493,7 @@ SUBROUTINE rotate_psi(evc,evcr,s,ftau,gk,nl,igk,nr1,nr2,nr3, &
!
psic(nl(igk(1:npw))) = evc(1:npw)
!
CALL cft3( psic, nr1, nr2, nr3, nrx1, nrx2, nrx3, 1 )
CALL invfft ('Dense', psic, dfftp)
!
#if defined (__PARA)
!
@ -565,7 +567,7 @@ SUBROUTINE rotate_psi(evc,evcr,s,ftau,gk,nl,igk,nr1,nr2,nr3, &
!
#endif
!
CALL cft3( psir, nr1, nr2, nr3, nrx1, nrx2, nrx3, -1 )
CALL fwfft ('Dense', psir, dfftp)
!
evcr(1:npw) = psir(nl(igk(1:npw)))
!
@ -794,7 +796,9 @@ SUBROUTINE rotate_psi_so(evc_nc,evcr,s,ftau,d_spin,has_e,gk,nl,igk,npol, &
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE fft_base, ONLY : cgather_sym, cscatter_sym
USE fft_base, ONLY : cgather_sym, cscatter_sym, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
IMPLICIT NONE
INTEGER :: npol, nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, ngm, npw, nbnd, npwx
@ -828,7 +832,7 @@ SUBROUTINE rotate_psi_so(evc_nc,evcr,s,ftau,d_spin,has_e,gk,nl,igk,npol, &
DO ipol=1,npol
!
psic(nl(igk(1:npw)),ipol) = evc_nc(1:npw,ipol)
CALL cft3( psic(1,ipol), nr1, nr2, nr3, nrx1, nrx2, nrx3, 1 )
CALL invfft ('Dense', psic(:,ipol), dfftp)
!
#if defined (__PARA)
!
@ -896,7 +900,7 @@ SUBROUTINE rotate_psi_so(evc_nc,evcr,s,ftau,d_spin,has_e,gk,nl,igk,npol, &
!
#endif
!
CALL cft3( psir(1,ipol), nr1, nr2, nr3, nrx1, nrx2, nrx3, -1 )
CALL fwfft ('Dense', psir(:,ipol), dfftp)
!
evcr_save(1:npw,ipol) = psir(nl(igk(1:npw)),ipol)
!

4
PP/wannier_plot.f90
View File

@ -96,6 +96,8 @@ SUBROUTINE plot_wannier(nc,n0)
USE buffers
USE symm_base, ONLY : nsym
USE ldaU, ONLY : swfcatom
USE fft_base, ONLY: dffts
USE fft_interfaces, ONLY : invfft
USE gvect
USE gsmooth
USE cell_base
@ -147,7 +149,7 @@ SUBROUTINE plot_wannier(nc,n0)
psic (nls (igk (j) ) ) = wan_func (j, plot_wan_num)
ENDDO
CALL cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
CALL invfft ('Wave', psic, dffts)
DO k=1, nrx3s
DO j=1,nrx2s