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

More removal of index I/O (iunigk) 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12488 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2016-06-13 09:59:33 +00:00
parent 7e4e1d9228
commit 675104436e
8 changed files with 49 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
PHonon/PH/add_zstar_ue.f90
View File

@ -14,14 +14,13 @@ subroutine add_zstar_ue (imode0, npe)
! trans =.true. is needed for this calculation to be meaningful
!
USE kinds, only : DP
USE klist, ONLY : xk, wk
USE klist, ONLY : xk, wk, ngk, igk_k
USE uspp, ONLY : vkb
USE wvfct, ONLY : npwx, npw, igk
USE wvfct, ONLY : npwx
USE wavefunctions_module, ONLY: evc
USE noncollin_module, ONLY: noncolin
USE io_files, ONLY: iunigk
USE buffers, ONLY : get_buffer
USE qpoint, ONLY: npwq, nksq
USE qpoint, ONLY: nksq
USE eqv, ONLY: dpsi, dvpsi
USE efield_mod, ONLY: zstarue0_rec
USE units_ph, ONLY : iudwf, lrdwf, iuwfc, lrwfc
@ -38,6 +37,7 @@ subroutine add_zstar_ue (imode0, npe)
! counter on records
! counter on modes
! counter on k points
INTEGER :: npw, npwq
real(DP) :: weight
@ -45,13 +45,12 @@ subroutine add_zstar_ue (imode0, npe)
call start_clock('add_zstar_ue')
zstarue0_rec=(0.0_DP,0.0_DP)
if (nksq.gt.1) rewind (iunigk)
do ik = 1, nksq
if (nksq.gt.1) read (iunigk) npw, igk
npw = ngk(ik)
npwq = npw
weight = wk (ik)
if (nksq.gt.1) call get_buffer (evc, lrwfc, iuwfc, ik)
call init_us_2 (npw, igk, xk (1, ik), vkb)
call init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
do jpol = 1, 3
!
! read/compute DeltaV*psi(bare) for electric field

14
PHonon/PH/add_zstar_ue_us.f90
View File

@ -17,14 +17,13 @@ subroutine add_zstar_ue_us(imode0,npe)
!
USE kinds, ONLY : DP
USE klist, ONLY : xk, wk
USE klist, ONLY : xk, wk, ngk, igk_k
USE uspp, ONLY : nkb, vkb
USE wvfct, ONLY : npwx, npw, nbnd, igk
USE wvfct, ONLY : npwx, nbnd
USE noncollin_module, ONLY : npol
USE wavefunctions_module, ONLY : evc
USE io_files, ONLY: iunigk
USE buffers, ONLY: get_buffer
USE qpoint, ONLY : npwq, nksq
USE qpoint, ONLY : nksq
USE efield_mod, ONLY: zstarue0_rec
USE eqv, ONLY : dpsi, dvpsi
USE modes, ONLY : u
@ -39,7 +38,7 @@ subroutine add_zstar_ue_us(imode0,npe)
integer, intent(in) :: imode0, npe
integer :: ik, jpol, nrec, mode, ipert, ibnd, jbnd, i,j
INTEGER :: npw, npwq
real(DP) :: weight
complex(DP), allocatable :: pdsp(:,:)
@ -51,13 +50,12 @@ subroutine add_zstar_ue_us(imode0,npe)
allocate (pdsp(nbnd,nbnd))
allocate (dvkb(npwx,nkb,3))
if (nksq.gt.1) rewind (iunigk)
do ik = 1, nksq
if (nksq.gt.1) read (iunigk) npw, igk
npw = ngk(ik)
npwq = npw
weight = wk (ik)
if (nksq.gt.1) call get_buffer (evc, lrwfc, iuwfc, ik)
call init_us_2 (npw, igk, xk (1, ik), vkb)
call init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
call dvkb3(ik,dvkb)
do ipert = 1, npe
mode = imode0 + ipert

32
PHonon/PH/dhdrhopsi.f90
View File

@ -37,12 +37,11 @@ subroutine dhdrhopsi
! i, j are band indexes
USE kinds, ONLY : DP
USE io_files, ONLY : iunigk
USE buffers, ONLY : get_buffer
USE cell_base, ONLY : tpiba, at
USE klist, ONLY : xk, nkstot
USE klist, ONLY : xk, nkstot, ngk, igk_k
USE fft_base, ONLY : dffts
USE wvfct, ONLY : npw, npwx, nbnd, et, igk, current_k
USE wvfct, ONLY : npwx, nbnd, et, current_k
USE uspp, ONLY : nkb, vkb
USE wavefunctions_module, ONLY: evc
USE becmod, ONLY : calbec, bec_type, allocate_bec_type, &
@ -52,7 +51,7 @@ subroutine dhdrhopsi
USE lrus, ONLY : becp1
USE eqv, ONLY : dpsi, dvpsi
USE qpoint, ONLY : npwq, nksq
USE qpoint, ONLY : nksq
USE control_lr, ONLY : nbnd_occ
USE mp_pools, ONLY : inter_pool_comm
@ -64,6 +63,7 @@ subroutine dhdrhopsi
logical :: d_test
! .true. ==> re-calculates the dielectric constant
integer :: npw, npwq
integer :: ik, isg, ibnd, jbnd, ir, ipa, ipb, nrec, max_iter
! counter on k-points
! sign in xk +/- delta_xk
@ -88,7 +88,6 @@ subroutine dhdrhopsi
complex(DP) , allocatable :: ev_sw (:,:), chif (:,:,:), &
depsi (:,:,:), auxg(:), dvscfs (:,:), &
auxr (:), au2r (:), ps0 (:), ps1 (:,:), ps2 (:,:,:)
TYPE(bec_type) :: becp1_sw
! wavefunctions swap space
! the chi-wavefunction
! auxiliary space
@ -97,6 +96,7 @@ subroutine dhdrhopsi
! auxiliary wavefunct. in G-space
! potential on the smooth grid
! auxiliary wavefunct. in real space
TYPE(bec_type) :: becp1_sw
! scalar products
complex(DP) :: itdba, tmpc
! i / ( 2 * delta_xk )
@ -122,10 +122,7 @@ subroutine dhdrhopsi
write (6,'(/5x,''Derivative coefficient:'',f10.6, &
& '' Threshold:'',1pe9.2)') dek, eth_ns
itdba = CMPLX(0.d0, 0.5d0 / (dek * tpiba),kind=DP)
npwq = npw
max_iter = 20
if (nksq.gt.1) rewind (iunigk)
!
! d_test = .true. ==> computes the dielectric tensor in an alternative way
! ( this is used only for testing or debugging purposes )
@ -148,14 +145,14 @@ subroutine dhdrhopsi
! Computes the derivative with respect to the k-point by finite
! differentiation
!
if (nksq.gt.1) read (iunigk) npw, igk
npwq = npw
npw =ngk(ik)
npwq= npw
current_k = ik
chif (:,:,:) = (0.d0, 0.d0)
!
! ev_sw contains the wavefunction of the k-point; the real value of the
! k-point and of the eigenvalues are written on a swap space
!
chif (:,:,:) = (0.d0, 0.d0)
call dcopy (3, xk (1, ik), 1, xk_sw, 1)
call dcopy (nbnd, et (1, ik), 1, et_sw, 1)
call beccopy (becp1(ik), becp1_sw, nkb, nbnd)
@ -168,24 +165,25 @@ subroutine dhdrhopsi
! We are deriving with respect to the three crystal axes
!
do ipb = 1, 3
xk(ipb,ik) = xk_sw(ipb) + &
DBLE(isg)*dek*at(ipb,ipa)
xk(ipb,ik) = xk_sw(ipb) + DBLE(isg)*dek*at(ipb,ipa)
enddo
!
! Calculates in a non self-consistent way the wavefunction
! at xk+dek and stores in evc
!
call zcopy (npwx * nbnd, ev_sw, 1, evc, 1) ! set an initial value
call hdiag ( max_iter, avg_iter1, xk(1,ik), et(1,ik) )
! call init_us_2 (npw, igk, xk (1, ik), vkb)
call g2_kin (ik)
call init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb)
!
call hdiag ( npw, max_iter, avg_iter1, et(1,ik) )
!
call calbec (npw, vkb, evc, becp1(ik) )
do ipb = 1, 3
!
! Calculates in a non-scf way the derivative of the
! wavefunction at xk+dek.
! solve_e_nscf uses:
! vkb, g2kin --common variables previously calcd. by hdiag--
! vkb, g2kin --common variables previously calculated
! evc --contains the wavefunction at xk+dek--
! dvscfs --self consist. part of the potential deriv.--
! The derivatives of the wavefunctions are stored in dpsi

8
PHonon/PH/dielec_test.f90
View File

@ -16,10 +16,8 @@ subroutine dielec_test
USE kinds, ONLY : DP
USE constants,ONLY : fpi
USE cell_base,ONLY : omega, at, bg
USE klist, ONLY : wk
USE wvfct, ONLY : npw, igk
USE klist, ONLY : wk, ngk
USE symme, ONLY : symmatrix, crys_to_cart
USE io_files, ONLY : iunigk
USE buffers, ONLY : get_buffer
USE wavefunctions_module, ONLY: evc
USE efield_mod, ONLY : epsilon
@ -35,14 +33,14 @@ subroutine dielec_test
implicit none
INTEGER :: npw
integer :: ibnd, ipol, jpol, nrec, ik, i1, i2
real(DP) :: w_, weight, tmp
complex(DP), external :: zdotc
epsilon (:,:) = 0.d0
if (nksq > 1) rewind (unit=iunigk)
do ik = 1, nksq
if (nksq > 1) read (iunigk) npw, igk
npw = ngk(ik)
weight = wk (ik)
w_ = - fpi * weight / omega
call get_buffer (evc, lrwfc, iuwfc, ik)

29
PHonon/PH/dvpsi_e2.f90
View File

@ -16,15 +16,14 @@ subroutine dvpsi_e2
!
USE kinds, ONLY : DP
USE cell_base, ONLY : omega
USE klist, ONLY : wk
USE klist, ONLY : wk, ngk
USE gvecs, ONLY : doublegrid
USE wvfct, ONLY : npw, npwx, nbnd, igk
USE wvfct, ONLY : npwx, nbnd
USE wavefunctions_module, ONLY: evc
USE buffers, ONLY : get_buffer
USE fft_base, ONLY : dfftp, dffts
USE scf, ONLY : rho
USE io_files, ONLY : iunigk
USE qpoint, ONLY : npwq, nksq
USE qpoint, ONLY : nksq
USE units_ph, ONLY : lrdrho, iudrho, lrdwf, iudwf, lrwfc, iuwfc
USE control_lr, ONLY : nbnd_occ
USE ramanm, ONLY : lrba2, iuba2, lrchf, iuchf, a1j, a2j
@ -35,6 +34,7 @@ subroutine dvpsi_e2
implicit none
INTEGER :: npw, npwq
integer :: ik, ipa, ipb, ir, ibnd, jbnd, nrec
! counter on k-points
! counter on polarizations
@ -73,13 +73,10 @@ subroutine dvpsi_e2
allocate (ps (nbnd,nbnd,3,3))
raux6 (:,:) = 0.d0
if (nksq.gt.1) rewind (iunigk)
do ik = 1, nksq
if (nksq.gt.1) then
read (iunigk) npw, igk
npwq = npw
call get_buffer (evc, lrwfc, iuwfc, ik)
endif
npw = ngk(ik)
npwq = npw
if (nksq.gt.1) call get_buffer (evc, lrwfc, iuwfc, ik)
weight = 2.d0 * wk(ik) / omega
do ipa = 1, 3
@ -93,8 +90,7 @@ subroutine dvpsi_e2
enddo
do ipa = 1, 6
do ir = 1, dffts%nnr
tmp = CONJG(aux3s (ir, a1j (ipa))) * &
aux3s (ir, a2j (ipa))
tmp = CONJG(aux3s (ir, a1j (ipa))) * aux3s (ir, a2j (ipa))
raux6 (ir, ipa) = raux6 (ir, ipa) + weight * DBLE (tmp)
enddo
enddo
@ -211,13 +207,10 @@ subroutine dvpsi_e2
allocate (auxs1 (dffts%nnr))
allocate (auxs2 (dffts%nnr))
if (nksq.gt.1) rewind (iunigk)
do ik = 1, nksq
if (nksq.gt.1) then
read (iunigk) npw, igk
npwq = npw
call get_buffer(evc, lrwfc, iuwfc, ik)
endif
npw = ngk(ik)
npwq = npw
if (nksq.gt.1) call get_buffer (evc, lrwfc, iuwfc, ik)
do ipa = 1, 6
nrec = (ipa - 1) * nksq + ik
call davcio (auxg, lrchf, iuchf, nrec, -1)

22
PHonon/PH/hdiag.f90
View File

@ -7,29 +7,26 @@
!
!
!-----------------------------------------------------------------------
subroutine hdiag( max_iter, avg_iter, xk_, et_ )
subroutine hdiag( npw, max_iter, avg_iter, et_ )
!
! Diagonalizes the unperturbed Hamiltonian in a non-selfconsistent way
! by Conjugate Gradient (band-by-band)
!
USE kinds, ONLY : DP
USE cell_base, ONLY: tpiba2
USE gvect, ONLY: g, gstart
USE wvfct, ONLY: g2kin, igk, nbnd, npwx, npw
USE wvfct, ONLY: g2kin, nbnd, npwx
USE uspp, ONLY: vkb, okvan
USE noncollin_module, ONLY: npol
USE wavefunctions_module,ONLY: evc
USE ramanm, ONLY: eth_ns
implicit none
!
! I/O variables:
!
integer :: max_iter
integer :: npw, max_iter
! maximum number of iterations
real(DP) :: avg_iter, xk_(3), et_(nbnd)
real(DP) :: avg_iter, et_(nbnd)
! iteration number in the diagonalization
! k-point
! eigenvalues of the diagonalization
!
! Local variables:
@ -48,19 +45,10 @@ subroutine hdiag( max_iter, avg_iter, xk_, et_ )
call start_clock ('hdiag')
allocate (h_prec( npwx), btype(nbnd))
btype(:) = 1
!
! various initializations
!
call init_us_2 (npw, igk, xk_, vkb)
!
! sets the kinetic energy
!
do ig = 1, npw
g2kin (ig) =((xk_ (1) + g (1, igk (ig) ) ) **2 + &
(xk_ (2) + g (2, igk (ig) ) ) **2 + &
(xk_ (3) + g (3, igk (ig) ) ) **2 ) * tpiba2
enddo
btype(:) = 1
!
! Conjugate-Gradient diagonalization
!

7
PHonon/PH/make.depend
View File

@ -20,7 +20,6 @@ add_for_charges.o : ../../Modules/recvec.o
add_for_charges.o : ../../Modules/uspp.o
add_for_charges.o : ../../PW/src/pwcom.o
add_zstar_ue.o : ../../LR_Modules/lrcom.o
add_zstar_ue.o : ../../Modules/io_files.o
add_zstar_ue.o : ../../Modules/kind.o
add_zstar_ue.o : ../../Modules/noncol.o
add_zstar_ue.o : ../../Modules/uspp.o
@ -29,7 +28,6 @@ add_zstar_ue.o : ../../PW/src/buffers.o
add_zstar_ue.o : ../../PW/src/pwcom.o
add_zstar_ue.o : phcom.o
add_zstar_ue_us.o : ../../LR_Modules/lrcom.o
add_zstar_ue_us.o : ../../Modules/io_files.o
add_zstar_ue_us.o : ../../Modules/kind.o
add_zstar_ue_us.o : ../../Modules/mp.o
add_zstar_ue_us.o : ../../Modules/mp_bands.o
@ -334,7 +332,6 @@ dhdrhopsi.o : ../../LR_Modules/lrcom.o
dhdrhopsi.o : ../../Modules/becmod.o
dhdrhopsi.o : ../../Modules/cell_base.o
dhdrhopsi.o : ../../Modules/fft_base.o
dhdrhopsi.o : ../../Modules/io_files.o
dhdrhopsi.o : ../../Modules/kind.o
dhdrhopsi.o : ../../Modules/mp.o
dhdrhopsi.o : ../../Modules/mp_bands.o
@ -362,7 +359,6 @@ dielec.o : phcom.o
dielec_test.o : ../../LR_Modules/lrcom.o
dielec_test.o : ../../Modules/cell_base.o
dielec_test.o : ../../Modules/constants.o
dielec_test.o : ../../Modules/io_files.o
dielec_test.o : ../../Modules/kind.o
dielec_test.o : ../../Modules/mp.o
dielec_test.o : ../../Modules/mp_bands.o
@ -478,7 +474,6 @@ dvpsi_e2.o : ../../LR_Modules/dv_of_drho.o
dvpsi_e2.o : ../../LR_Modules/lrcom.o
dvpsi_e2.o : ../../Modules/cell_base.o
dvpsi_e2.o : ../../Modules/fft_base.o
dvpsi_e2.o : ../../Modules/io_files.o
dvpsi_e2.o : ../../Modules/kind.o
dvpsi_e2.o : ../../Modules/mp.o
dvpsi_e2.o : ../../Modules/mp_bands.o
@ -696,7 +691,6 @@ generate_effective_charges_c.o : ../../PW/src/symme.o
gmressolve_all.o : ../../Modules/kind.o
gmressolve_all.o : ../../Modules/mp.o
gmressolve_all.o : ../../Modules/mp_bands.o
hdiag.o : ../../Modules/cell_base.o
hdiag.o : ../../Modules/kind.o
hdiag.o : ../../Modules/noncol.o
hdiag.o : ../../Modules/recvec.o
@ -1011,7 +1005,6 @@ phqscf.o : write_rec.o
polariz.o : ../../LR_Modules/lrcom.o
polariz.o : ../../Modules/cell_base.o
polariz.o : ../../Modules/constants.o
polariz.o : ../../Modules/io_files.o
polariz.o : ../../Modules/io_global.o
polariz.o : ../../Modules/kind.o
polariz.o : ../../Modules/mp.o

9
PHonon/PH/polariz.f90
View File

@ -14,12 +14,11 @@ subroutine polariz ( iw, iu )
!
USE io_global, ONLY : stdout
USE io_files, ONLY : iunigk
USE constants, ONLY : fpi
USE cell_base, ONLY : at, bg, omega
USE klist, ONLY : wk
USE klist, ONLY : wk, ngk
USE symme, ONLY : symmatrix, crys_to_cart
USE wvfct, ONLY : npw, npwx, igk
USE wvfct, ONLY : npwx
USE kinds, ONLY : DP
USE control_lr, ONLY : nbnd_occ
USE units_ph, ONLY : lrdwf, iudwf, lrebar, iuebar
@ -53,9 +52,7 @@ subroutine polariz ( iw, iu )
call start_clock ('polariz')
repsilon(:,:) = 0.d0
if (nksq > 1) rewind (unit = iunigk)
do ik = 1, nksq
if (nksq > 1) read (iunigk) npw, igk
weight = wk (ik)
w = fpi * weight / omega
do ipol = 1, 3
@ -69,7 +66,7 @@ subroutine polariz ( iw, iu )
! this is the real part of <DeltaV*psi(E)|DeltaPsi(E)>
!
repsilon(ipol,jpol)=repsilon(ipol,jpol)-4.d0*w*REAL( &
zdotc (npw, dvpsi (1, ibnd), 1, dpsi (1, ibnd), 1) )
zdotc ( ngk(ik), dvpsi (1, ibnd), 1, dpsi (1, ibnd), 1) )
enddo
enddo
enddo