mirror of https://gitlab.com/QEF/q-e.git
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:
parent
987f75d2bb
commit
be2f483311
|
@ -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)
|
||||
!
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
!
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
18
PP/elf.f90
|
@ -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
|
||||
|
|
|
@ -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,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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
!
|
||||
|
|
|
@ -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 (:) )
|
||||
!
|
||||
|
|
|
@ -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
14
PP/pw2gw.f90
|
@ -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
|
||||
|
|
|
@ -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
12
PP/stm.f90
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
!
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue