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

Update of the TDDFPT codes: 1) Since the variable npw_k(:) was merged into nkg(:) in PW, 

the same is done in TDDFPT, 2) The indices igk are no longer written to the file 
(unit iunigk), but kept in memory in igk_k, as was done in PW 3) removal of variables 
which are not used.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12107 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
timrov 2016-02-09 14:31:51 +00:00
parent d2a46b17b0
commit 2d3a709671
18 changed files with 136 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
TDDFPT/src/lr_apply_liouvillian.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -33,7 +33,7 @@ SUBROUTINE lr_apply_liouvillian( evc1, evc1_new, sevc1_new, interaction )
USE gvect, ONLY : nl, ngm, gstart, g, gg
USE io_global, ONLY : stdout
USE kinds, ONLY : dp
USE klist, ONLY : nks, xk, npw_k => ngk, igk_k
USE klist, ONLY : nks, xk, ngk, igk_k
USE lr_variables, ONLY : evc0, revc0, rho_1, rho_1c, &
& ltammd, size_evc, no_hxc, lr_exx, &
& scissor, davidson, lr_verbosity
@ -301,7 +301,7 @@ SUBROUTINE lr_apply_liouvillian( evc1, evc1_new, sevc1_new, interaction )
!
DO ik = 1, nks
!
CALL sm1_psi(.FALSE., ik, npwx, npw_k(ik), nbnd, &
CALL sm1_psi(.FALSE., ik, npwx, ngk(ik), nbnd, &
& sevc1_new(1,1,ik), evc1_new(1,1,ik))
!
ENDDO
@ -523,7 +523,7 @@ CONTAINS
!
IF( nkb > 0 .and. okvan .and. real_space_debug <= 7) THEN
!The non real_space part
CALL dgemm( 'N', 'N', 2*npw_k(1), nbnd, nkb, 1.d0, vkb, &
CALL dgemm( 'N', 'N', 2*ngk(1), nbnd, nkb, 1.d0, vkb, &
2*npwx, becp2, nkb, 1.d0, evc1_new, 2*npwx )
!
ENDIF
@ -547,7 +547,7 @@ CONTAINS
!
! Call h_psi on evc1 such that h.evc1 = sevc1_new
!
CALL h_psi(npwx,npw_k(1),nbnd,evc1(1,1,1),sevc1_new(1,1,1)) ! g2kin is needed here
CALL h_psi(npwx,ngk(1),nbnd,evc1(1,1,1),sevc1_new(1,1,1)) ! g2kin is needed here
!
! spsi1 = s*evc1
!
@ -558,14 +558,14 @@ CONTAINS
CALL fwfft_orbital_gamma(spsi1,ibnd,nbnd)
ENDDO
ELSE
CALL s_psi(npwx,npw_k(1),nbnd,evc1(1,1,1),spsi1)
CALL s_psi(npwx,ngk(1),nbnd,evc1(1,1,1),spsi1)
ENDIF
!
! Subtract the eigenvalues
!
DO ibnd = 1,nbnd
!
CALL zaxpy(npw_k(1), CMPLX(-(et(ibnd,1)-scissor),0.0d0,dp), &
CALL zaxpy(ngk(1), CMPLX(-(et(ibnd,1)-scissor),0.0d0,dp), &
& spsi1(:,ibnd), 1, sevc1_new(:,ibnd,1), 1)
!
ENDDO
@ -627,7 +627,7 @@ SUBROUTINE lr_apply_liouvillian_k()
!
CALL fwfft ('Wave', psic, dffts)
!
DO ig = 1,npw_k(ik)
DO ig = 1,ngk(ik)
!
evc1_new(ig,ibnd,ik) = psic(nls(igk_k(ig,ik)))
!
@ -643,7 +643,7 @@ SUBROUTINE lr_apply_liouvillian_k()
!
DO ik = 1,nks
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
!
becp2(:,:) = 0.0d0
!
@ -682,7 +682,7 @@ SUBROUTINE lr_apply_liouvillian_k()
ENDDO
!
!evc1_new(ik) = evc1_new(ik) + vkb*becp2(ik)
CALL zgemm( 'N', 'N', npw_k(ik), nbnd, nkb, (1.d0,0.d0), vkb, &
CALL zgemm( 'N', 'N', ngk(ik), nbnd, nkb, (1.d0,0.d0), vkb, &
npwx, becp2, nkb, (1.d0,0.d0), evc1_new(:,:,ik), npwx )
!
ENDDO
@ -698,9 +698,9 @@ SUBROUTINE lr_apply_liouvillian_k()
!
DO ik=1,nks
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
!
DO ig = 1,npw_k(ik)
DO ig = 1, ngk(ik)
!
g2kin(ig)=((xk(1,ik)+g(1,igk_k(ig,ik)))**2 &
+(xk(2,ik)+g(2,igk_k(ig,ik)))**2 &
@ -710,18 +710,18 @@ SUBROUTINE lr_apply_liouvillian_k()
!
igk(:) = igk_k(:,ik)
current_k = ik
npw = npw_k(ik)
npw = ngk(ik)
!
CALL h_psi(npwx,npw_k(ik),nbnd,evc1(1,1,ik),sevc1_new(1,1,ik))
CALL h_psi(npwx,ngk(ik),nbnd,evc1(1,1,ik),sevc1_new(1,1,ik))
!
CALL s_psi(npwx,npw_k(ik),nbnd,evc1(1,1,ik),spsi1)
CALL s_psi(npwx,ngk(ik),nbnd,evc1(1,1,ik),spsi1)
!
! Subtract the eigenvalues
! IT: One may want to add scissor
!
DO ibnd=1,nbnd
!
DO ig=1,npw_k(ik)
DO ig=1,ngk(ik)
!
sevc1_new(ig,ibnd,ik)=sevc1_new(ig,ibnd,ik) &
-cmplx(et(ibnd,ik),0.0d0,dp)*spsi1(ig,ibnd)

12
TDDFPT/src/lr_calc_dens.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -30,7 +30,7 @@ SUBROUTINE lr_calc_dens( evc1, response_calc )
USE fft_interfaces, ONLY : invfft
USE io_global, ONLY : stdout
USE kinds, ONLY : dp
USE klist, ONLY : nks, xk, wk, npw_k => ngk, igk_k
USE klist, ONLY : nks, xk, wk, ngk, igk_k
USE lr_variables, ONLY : evc0,revc0,rho_1,lr_verbosity,&
& charge_response, itermax,&
& cube_save, LR_iteration,&
@ -487,7 +487,7 @@ CONTAINS
!
IF ( real_space_debug <= 6) THEN
! In real space, the value is calculated above
CALL calbec(npw_k(1), vkb, evc1(:,:,1), becp)
CALL calbec(ngk(1), vkb, evc1(:,:,1), becp)
!
ENDIF
!
@ -594,7 +594,7 @@ CONTAINS
!
psic(:) = (0.0d0,0.0d0)
!
DO ig=1,npw_k(ik)
DO ig = 1, ngk(ik)
psic(nls(igk_k(ig,ik)))=evc1(ig,ibnd,ik)
ENDDO
!
@ -625,7 +625,7 @@ CONTAINS
!
! Calculate the beta-functions vkb
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
!
scal = 0.0d0
becsum(:,:,:) = 0.0d0
@ -633,7 +633,7 @@ CONTAINS
! Calculate the product of beta-functions vkb with the
! wavefunctions evc1 : becp%k = <vkb|evc1>
!
CALL calbec(npw_k(ik),vkb,evc1(:,:,ik),becp)
CALL calbec(ngk(ik),vkb,evc1(:,:,ik),becp)
!
CALL start_clock( 'becsum' )
!

14
TDDFPT/src/lr_charg_resp.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -641,9 +641,9 @@ CONTAINS
USE ions_base, ONLY : ityp,nat,ntyp=>nsp
USE realus, ONLY : real_space_debug,invfft_orbital_gamma,calbec_rs_gamma
USE gvect, ONLY : gstart
USE klist, ONLY : nks, npw_k => ngk
USE klist, ONLY : nks, ngk
USE lr_variables, ONLY : lr_verbosity, itermax, LR_iteration, LR_polarization, &
project,evc0_virt,F,nbnd_total,n_ipol, becp1_virt
project,evc0_virt,F,nbnd_total,n_ipol, becp1_virt
IMPLICIT NONE
!
@ -679,7 +679,7 @@ CONTAINS
CALL calbec_rs_gamma(ibnd,nbnd,becp%r)
ENDDO
ELSE
CALL calbec(npw_k(1), vkb, evc1(:,:,1), becp)
CALL calbec(ngk(1), vkb, evc1(:,:,1), becp)
ENDIF
ENDIF
!
@ -756,7 +756,7 @@ CONTAINS
! US part finished
!first part
! the dot product <evc1|evc0> taken from lr_dot
SSUM=(2.D0*wg(ibnd_occ,1)*DDOT(2*npw_k(1),evc0_virt(:,ibnd_virt,1),1,evc1(:,ibnd_occ,1),1))
SSUM=(2.D0*wg(ibnd_occ,1)*DDOT(2*ngk(1),evc0_virt(:,ibnd_virt,1),1,evc1(:,ibnd_occ,1),1))
IF (gstart==2) SSUM = SSUM - (wg(ibnd_occ,1)*dble(evc1(1,ibnd_occ,1))*dble(evc0_virt(1,ibnd_virt,1)))
!US contribution
SSUM=SSUM+scal
@ -787,7 +787,7 @@ CONTAINS
USE ions_base, ONLY : ityp,nat,ntyp=>nsp
USE realus, ONLY : real_space_debug,invfft_orbital_gamma,calbec_rs_gamma
USE gvect, ONLY : gstart
USE klist, ONLY : nks, npw_k => ngk
USE klist, ONLY : nks, ngk
USE lr_variables, ONLY : lr_verbosity, itermax, LR_iteration, LR_polarization, &
project,evc0_virt,R,nbnd_total,n_ipol, becp1_virt,d0psi
@ -805,7 +805,7 @@ CONTAINS
DO ibnd_occ=1,nbnd
DO ibnd_virt=1,(nbnd_total-nbnd)
! the dot product <evc0|sd0psi> taken from lr_dot
SSUM=(2.D0*wg(ibnd_occ,1)*DDOT(2*npw_k(1),evc0_virt(:,ibnd_virt,1),1,d0psi(:,ibnd_occ,1,ipol),1))
SSUM=(2.D0*wg(ibnd_occ,1)*DDOT(2*ngk(1),evc0_virt(:,ibnd_virt,1),1,d0psi(:,ibnd_occ,1,ipol),1))
IF (gstart==2) SSUM = SSUM - (wg(ibnd_occ,1)*dble(d0psi(1,ibnd_occ,1,ipol))*dble(evc0_virt(1,ibnd_virt,1)))
#ifdef __MPI
CALL mp_sum(SSUM, intra_bgrp_comm)

6
TDDFPT/src/lr_dealloc.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -18,7 +18,7 @@ SUBROUTINE lr_dealloc()
USE uspp, ONLY : nkb
USE control_flags, ONLY : gamma_only
USE realus, ONLY : tg_psic
USE klist, ONLY : npw_k => ngk, igk_k
USE klist, ONLY : ngk, igk_k
USE io_global, ONLY : stdout
USE charg_resp, ONLY : w_T_beta_store, w_T_gamma_store, w_T,&
& w_T_zeta_store, chi, rho_1_tot, rho_1_tot_im
@ -59,7 +59,7 @@ SUBROUTINE lr_dealloc()
IF (allocated(rho_1c)) DEALLOCATE(rho_1c)
IF (allocated(dmuxc)) DEALLOCATE(dmuxc)
IF (allocated(igk_k)) DEALLOCATE(igk_k)
IF (allocated(npw_k)) DEALLOCATE(npw_k)
IF (allocated(ngk)) DEALLOCATE(ngk)
!
! EELS-related variables
!

18
TDDFPT/src/lr_dot.f90
View File

@ -19,7 +19,7 @@ FUNCTION lr_dot(x,y)
!
USE kinds, ONLY : dp
USE io_global, ONLY : stdout
USE klist, ONLY : nks, xk, wk, npw_k => ngk
USE klist, ONLY : nks, xk, wk, ngk
USE lsda_mod, ONLY : nspin
USE wvfct, ONLY : npwx,nbnd,wg,npw,igk,g2kin
USE gvecw, ONLY : gcutw
@ -96,7 +96,7 @@ CONTAINS
!
DO ibnd=1,nbnd
!
temp_gamma = temp_gamma + 2.D0*wg(ibnd,1)*DDOT(2*npw_k(1),x(:,ibnd,1),1,y(:,ibnd,1),1)
temp_gamma = temp_gamma + 2.D0*wg(ibnd,1)*DDOT(2*ngk(1),x(:,ibnd,1),1,y(:,ibnd,1),1)
!
! G=0 has been accounted twice, so we subtract one contribution.
!
@ -120,7 +120,7 @@ CONTAINS
DO ik=1,nks
DO ibnd=1,nbnd
!
temp_k = temp_k + wg(ibnd,ik) * ZDOTC(npw_k(ik),x(1,ibnd,ik),1,y(1,ibnd,ik),1)
temp_k = temp_k + wg(ibnd,ik) * ZDOTC(ngk(ik),x(1,ibnd,ik),1,y(1,ibnd,ik),1)
!
ENDDO
ENDDO
@ -195,7 +195,7 @@ SUBROUTINE check_vector_gamma (x)
USE kinds, ONLY : dp
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE klist , ONLY : ngk
USE gvect, ONLY : gstart
USE io_global, ONLY : stdout
!
@ -208,7 +208,7 @@ SUBROUTINE check_vector_gamma (x)
REAL(kind=dp) :: temp_gamma
REAL(kind=dp), EXTERNAL :: DDOT
!
temp_gamma = 2.D0*DDOT(2*npw_k(1),x(:),1,x(:),1)
temp_gamma = 2.D0*DDOT(2*ngk(1),x(:),1,x(:),1)
!
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1))*dble(x(1))
!
@ -232,7 +232,7 @@ SUBROUTINE check_vector_f (x)
USE kinds, ONLY : dp
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE klist , ONLY : ngk
USE gvect, ONLY : gstart
USE io_global, ONLY : stdout
!
@ -245,7 +245,7 @@ SUBROUTINE check_vector_f (x)
COMPLEX(kind=dp) :: temp_f
COMPLEX(kind=dp), EXTERNAL :: ZDOTC
!
temp_f = ZDOTC(npw_k(1),x(:),1,x(:),1)
temp_f = ZDOTC(ngk(1),x(:),1,x(:),1)
!
#ifdef __MPI
CALL mp_sum(temp_f, intra_bgrp_comm)
@ -267,7 +267,7 @@ SUBROUTINE check_all_bands_gamma (x,sx,nbnd1,nbnd2)
USE kinds, ONLY : dp
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE klist , ONLY : npw_k=>ngk
USE klist , ONLY : ngk
USE io_global, ONLY : stdout
USE gvect, ONLY : gstart
!
@ -285,7 +285,7 @@ SUBROUTINE check_all_bands_gamma (x,sx,nbnd1,nbnd2)
DO ibnd=1,nbnd1
DO jbnd=ibnd,nbnd2
!
temp_gamma = 2.D0*DDOT(2*npw_k(1),x(:,ibnd),1,sx(:,jbnd),1)
temp_gamma = 2.D0*DDOT(2*ngk(1),x(:,ibnd),1,sx(:,jbnd),1)
!
IF (gstart==2) temp_gamma = temp_gamma - dble(x(1,ibnd))*dble(sx(1,jbnd))
!

32
TDDFPT/src/lr_dvpsi_e.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -22,7 +22,7 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
USE cell_base, ONLY : tpiba, at
USE ions_base, ONLY : ntyp => nsp
USE io_global, ONLY : stdout
USE klist, ONLY : xk, npw_k => ngk
USE klist, ONLY : xk, ngk
USE wvfct, ONLY : npw, npwx, nbnd, igk, g2kin, et
USE wavefunctions_module, ONLY : evc
USE noncollin_module, ONLY : noncolin, npol
@ -78,7 +78,7 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
!
CALL allocate_bec_type ( nkb, nbnd, becp1 )
!
CALL calbec ( npw_k(ik), vkb, evc, becp1 )
CALL calbec ( ngk(ik), vkb, evc, becp1 )
!
CALL allocate_bec_type ( nkb, nbnd, becp2 )
!
@ -88,9 +88,9 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
! Apply -P^+_c
! NB it uses dvpsi as workspace
!
IF (okvan) CALL calbec ( npw_k(ik), vkb, evc, becp, nbnd)
IF (okvan) CALL calbec ( ngk(ik), vkb, evc, becp, nbnd)
!
CALL orthogonalize(d0psi, evc, ik, ik, dvpsi,npw_k(ik))
CALL orthogonalize(d0psi, evc, ik, ik, dvpsi, ngk(ik))
d0psi = -d0psi
!
! d0psi contains P^+_c [H-eS,x] psi_v for the polarization direction ipol
@ -102,11 +102,11 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
CALL lr_calc_eprec(eprec)
!
DO ibnd = 1, nbnd_occ (ik)
DO ig = 1, npw_k(ik)
DO ig = 1, ngk(ik)
h_diag (ig, ibnd) = 1.d0 / max (1.0d0, g2kin (ig) / eprec (ibnd) )
ENDDO
IF (noncolin) THEN
DO ig = 1, npw_k(ik)
DO ig = 1, ngk(ik)
h_diag (ig+npwx, ibnd) = 1.d0/max(1.0d0,g2kin(ig)/eprec(ibnd))
ENDDO
ENDIF
@ -119,7 +119,7 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
igkq => igk ! PG: needed by h_psiq, called by ch_psi_all
!
CALL cgsolve_all (ch_psi_all, cg_psi, et (1, ik), d0psi, dvpsi, &
h_diag, npwx, npw_k(ik), thresh, ik, lter, conv_root, anorm, &
h_diag, npwx, ngk(ik), thresh, ik, lter, conv_root, anorm, &
nbnd_occ(ik), 1)
!
IF (.not.conv_root) WRITE( stdout, '(5x,"ik",i4," ibnd",i4, &
@ -141,8 +141,8 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
! for effective charges
!
ALLOCATE (spsi ( npwx*npol, nbnd))
CALL calbec (npw_k(ik), vkb, dvpsi, becp )
CALL s_psi(npwx,npw_k(ik),nbnd,dvpsi,spsi)
CALL calbec (ngk(ik), vkb, dvpsi, becp )
CALL s_psi(npwx,ngk(ik),nbnd,dvpsi,spsi)
CALL DCOPY(2*npwx*npol*nbnd,spsi,1,dvpsi,1)
DEALLOCATE (spsi)
ALLOCATE (dpqq( nhm, nhm, 3, ntyp))
@ -155,12 +155,12 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
!
! orthogonalize dvpsi to the valence subspace
!
IF (okvan) CALL calbec ( npw_k(ik), vkb, evc, becp, nbnd)
IF (okvan) CALL calbec ( ngk(ik), vkb, evc, becp, nbnd)
!
ALLOCATE (work ( npwx, nbnd ) )
work = evc ! work will be corrupted on exit from orthogonalize
!
CALL orthogonalize(dvpsi, evc, ik, ik, work,npw_k(ik))
CALL orthogonalize(dvpsi, evc, ik, ik, work, ngk(ik))
dvpsi = -dvpsi
!
DEALLOCATE(work)
@ -172,7 +172,7 @@ SUBROUTINE lr_dvpsi_e(ik,ipol,dvpsi)
!
IF (okvan) THEN
ALLOCATE (spsi ( npwx*npol, nbnd))
CALL sm1_psi(.TRUE.,ik,npwx,npw_k(ik),nbnd,dvpsi,spsi)
CALL sm1_psi(.TRUE.,ik,npwx,ngk(ik),nbnd,dvpsi,spsi)
dvpsi(:,:) = spsi(:,:)
DEALLOCATE(spsi)
ENDIF
@ -204,7 +204,7 @@ CONTAINS
USE gvect, ONLY : gstart
USE wvfct, ONLY : npw, npwx, nbnd, g2kin
USE wavefunctions_module, ONLY : evc
USE klist, ONLY : npw_k => ngk
USE klist, ONLY : ngk
USE mp, ONLY : mp_sum
USE mp_global, ONLY : intra_bgrp_comm
@ -222,7 +222,7 @@ CONTAINS
!
work = 0.d0
!
DO ig = 1,npw_k(ik)
DO ig = 1, ngk(ik)
work(ig,1) = g2kin(ig)*evc(ig,ibnd)
ENDDO
!
@ -237,7 +237,7 @@ CONTAINS
eprec(ibnd) = 1.35d0*eprec(ibnd)
!
ELSE
eprec(ibnd) = 1.35d0*ZDOTC(npw_k(ik),evc(1,ibnd),1,work,1)
eprec(ibnd) = 1.35d0*ZDOTC(ngk(ik),evc(1,ibnd),1,work,1)
ENDIF
!
ENDDO

19
TDDFPT/src/lr_init_nfo.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -11,7 +11,7 @@ SUBROUTINE lr_init_nfo()
!
! This subroutine prepares several variables which are needed in the
! TDDFPT program:
! 1) Optical case: initialization of igk_k and npw_k.
! 1) Optical case: initialization of igk_k and ngk.
! 2) Initialization of ikks, ikqs, and nksq.
! 3) EELS: Calculate phases associated with a q vector.
! 4) Compute the number of occupied bands for each k point.
@ -22,7 +22,7 @@ SUBROUTINE lr_init_nfo()
!
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, tau
USE klist, ONLY : nks,degauss,lgauss,ngauss,xk,wk, npw_k=>ngk,&
USE klist, ONLY : nks,degauss,lgauss,ngauss,xk,wk,ngk,&
igk_k,nelec, two_fermi_energies, nelup, neldw
USE wvfct, ONLY : nbnd, et, igk, npw, g2kin
USE realus, ONLY : real_space
@ -64,15 +64,13 @@ SUBROUTINE lr_init_nfo()
REAL(DP), ALLOCATABLE :: wg_up(:,:), wg_dw(:,:)
LOGICAL :: exst ! logical variable to check file existence
!
! 1) Optical case: initialize igk_k and npw_k
! 1) Optical case: initialize igk_k and ngk
! Open shell related
!
IF (.NOT.eels) THEN
!
IF ( .not. allocated( igk_k ) ) ALLOCATE(igk_k(npwx,nks))
IF ( .not. allocated( npw_k ) ) ALLOCATE(npw_k(nks))
!
CALL seqopn( iunigk, 'igk', 'UNFORMATTED', exst )
IF ( .not. allocated( ngk ) ) ALLOCATE(ngk(nks))
!
IF (.not. real_space) THEN
!
@ -80,14 +78,9 @@ SUBROUTINE lr_init_nfo()
!
CALL gk_sort( xk(1,ik), ngm, g, gcutw, npw, igk, g2kin )
!
npw_k(ik) = npw
ngk(ik) = npw
igk_k(:,ik) = igk(:)
!
! S. Binnie: For systems with more than one kpoint, we also write
! igk to iunigk. This is required by exx_init().
!
IF ( nks > 1 ) WRITE( iunigk ) igk
!
ENDDO
!
ENDIF

16
TDDFPT/src/lr_normalise.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -19,7 +19,7 @@ SUBROUTINE lr_normalise (evc1, norm)
USE gvect, ONLY : gstart
USE cell_base, ONLY : omega
USE io_global, ONLY : stdout
USE klist, ONLY : nks, xk, npw_k=>ngk, igk_k
USE klist, ONLY : nks, xk, ngk, igk_k
USE lsda_mod, ONLY : nspin
USE uspp, ONLY : vkb, nkb, okvan
USE wvfct, ONLY : nbnd, npwx, npw, wg
@ -98,8 +98,8 @@ CONTAINS
!
! Non real_space & nkb > 0 case
!
CALL calbec(npw_k(1),vkb,evc1(:,:,1),becp)
CALL s_psi(npwx,npw_k(1),nbnd,evc1(1,1,1),spsi)
CALL calbec(ngk(1),vkb,evc1(:,:,1),becp)
CALL s_psi(npwx,ngk(1),nbnd,evc1(1,1,1),spsi)
!
ENDIF
!
@ -107,7 +107,7 @@ CONTAINS
!
! nkb = 0 (just array copying)
!
CALL s_psi(npwx,npw_k(1),nbnd,evc1(1,1,1),spsi)
CALL s_psi(npwx,ngk(1),nbnd,evc1(1,1,1),spsi)
!
ENDIF
!
@ -138,12 +138,12 @@ CONTAINS
!
IF ( nkb > 0 .and. okvan) THEN
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(npw_k(ik),vkb,evc1(:,:,ik),becp)
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(ngk(ik),vkb,evc1(:,:,ik),becp)
!
ENDIF
!
CALL s_psi(npwx,npw_k(ik),nbnd,evc1(:,:,ik),spsi(:,:,ik))
CALL s_psi(npwx,ngk(ik),nbnd,evc1(:,:,ik),spsi(:,:,ik))
!
ENDDO
!

30
TDDFPT/src/lr_ortho.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -30,7 +30,7 @@ SUBROUTINE lr_ortho(dvpsi, evq, ikk, ikq, sevc, inverse)
!
USE kinds, ONLY : DP
use gvect, only : gstart
USE klist, ONLY : npw_k=>ngk, lgauss, degauss, ngauss
USE klist, ONLY : ngk, lgauss, degauss, ngauss
USE noncollin_module, ONLY : noncolin, npol
USE wvfct, ONLY : npwx, nbnd, et
USE ener, ONLY : ef
@ -102,10 +102,10 @@ SUBROUTINE lr_ortho_k()
!
ps = (0.d0, 0.d0)
IF (inverse_mode) THEN
CALL ZGEMM( 'C', 'N', nbnd, nbnd_occ(ikk), npw_k(ikk), (1.d0,0.d0), &
CALL ZGEMM( 'C', 'N', nbnd, nbnd_occ(ikk), ngk(ikk), (1.d0,0.d0), &
sevc, npwx, dvpsi, npwx, (0.d0,0.d0), ps, nbnd )
ELSE
CALL ZGEMM( 'C', 'N', nbnd, nbnd_occ(ikk), npw_k(ikk), (1.d0,0.d0), &
CALL ZGEMM( 'C', 'N', nbnd, nbnd_occ(ikk), ngk(ikk), (1.d0,0.d0), &
evq, npwx, dvpsi, npwx, (0.d0,0.d0), ps, nbnd )
ENDIF
!
@ -132,7 +132,7 @@ SUBROUTINE lr_ortho_k()
ps(jbnd,ibnd) = wwg * ps(jbnd,ibnd)
!
ENDDO
CALL DSCAL (2*npw_k(ikk), wg1, dvpsi(1,ibnd), 1)
CALL DSCAL (2*ngk(ikk), wg1, dvpsi(1,ibnd), 1)
ENDDO
!
nbnd_eff = nbnd
@ -147,7 +147,7 @@ SUBROUTINE lr_ortho_k()
!
! ps = <sevc|dvpsi>
!
CALL ZGEMM( 'C', 'N', nbnd_occ(ikq), nbnd_occ (ikk), npw_k(ikk), &
CALL ZGEMM( 'C', 'N', nbnd_occ(ikq), nbnd_occ (ikk), ngk(ikk), &
(1.d0,0.d0), sevc, npwx, dvpsi, npwx, &
(0.d0,0.d0), ps, nbnd )
!
@ -155,7 +155,7 @@ SUBROUTINE lr_ortho_k()
!
! ps = <evq|dvpsi>
!
CALL ZGEMM( 'C', 'N', nbnd_occ(ikq), nbnd_occ (ikk), npw_k(ikk), &
CALL ZGEMM( 'C', 'N', nbnd_occ(ikq), nbnd_occ (ikk), ngk(ikk), &
(1.d0,0.d0), evq, npwx, dvpsi, npwx, &
(0.d0,0.d0), ps, nbnd )
ENDIF
@ -173,11 +173,11 @@ SUBROUTINE lr_ortho_k()
! Metallic case
!
if (inverse_mode) then
CALL ZGEMM( 'N', 'N', npw_k(ikk), nbnd_occ(ikk), nbnd, &
CALL ZGEMM( 'N', 'N', ngk(ikk), nbnd_occ(ikk), nbnd, &
(-1.d0,0.d0), evq, npwx, ps, nbnd, (1.0d0,0.d0), &
dvpsi, npwx )
else
CALL ZGEMM( 'N', 'N', npw_k(ikk), nbnd_occ(ikk), nbnd, &
CALL ZGEMM( 'N', 'N', ngk(ikk), nbnd_occ(ikk), nbnd, &
(-1.d0,0.d0), sevc, npwx, ps, nbnd, (1.0d0,0.d0), &
dvpsi, npwx )
endif
@ -190,7 +190,7 @@ SUBROUTINE lr_ortho_k()
!
! |dvspi> = |dvpsi> - |evq><sevc|dvpsi>
!
CALL ZGEMM( 'N', 'N', npw_k(ikk), nbnd_occ(ikk), nbnd_occ(ikk), &
CALL ZGEMM( 'N', 'N', ngk(ikk), nbnd_occ(ikk), nbnd_occ(ikk), &
(-1.d0,0.d0), evq, npwx, ps, nbnd, (1.0d0,0.d0), &
dvpsi, npwx )
!
@ -198,7 +198,7 @@ SUBROUTINE lr_ortho_k()
!
! |dvspi> = |dvpsi> - |sevc><evq|dvpsi>
!
CALL ZGEMM( 'N', 'N', npw_k(ikk), nbnd_occ(ikk), nbnd_occ(ikk), &
CALL ZGEMM( 'N', 'N', ngk(ikk), nbnd_occ(ikk), nbnd_occ(ikk), &
(-1.d0,0.d0), sevc, npwx, ps, nbnd, (1.0d0,0.d0), &
dvpsi, npwx )
!
@ -241,14 +241,14 @@ SUBROUTINE lr_ortho_gamma()
!
! ps = 2 * <sevc|dvpsi>
!
CALL DGEMM( 'C', 'N', nbnd, nbnd ,2*npw_k(1), &
CALL DGEMM( 'C', 'N', nbnd, nbnd ,2*ngk(1), &
2.d0, sevc, 2*npwx, dvpsi, 2*npwx, 0.d0, ps, nbnd )
!
ELSE
!
! ps = 2 * <evq|dvpsi>
!
CALL DGEMM( 'C', 'N', nbnd, nbnd ,2*npw_k(1), &
CALL DGEMM( 'C', 'N', nbnd, nbnd ,2*ngk(1), &
2.d0, evq, 2*npwx, dvpsi, 2*npwx, 0.d0, ps, nbnd )
!
ENDIF
@ -300,14 +300,14 @@ SUBROUTINE lr_ortho_gamma()
!
! |dvpsi> = |dvpsi> - |evq><sevc|dvpsi>
!
CALL ZGEMM( 'N', 'N', npw_k(1), nbnd, nbnd, &
CALL ZGEMM( 'N', 'N', ngk(1), nbnd, nbnd, &
(-1.d0,0.d0), evq, npwx, ps_c, nbnd, (1.0d0,0.d0), dvpsi, npwx)
!
ELSE
!
! |dvpsi> = |dvpsi> - |sevc><evq|dvpsi>
!
CALL ZGEMM( 'N', 'N', npw_k(1), nbnd, nbnd, &
CALL ZGEMM( 'N', 'N', ngk(1), nbnd, nbnd, &
(-1.d0,0.d0), sevc, npwx, ps_c, nbnd, (1.0d0,0.d0), dvpsi, npwx )
!
ENDIF

32
TDDFPT/src/lr_read_wf.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -17,7 +17,7 @@ SUBROUTINE lr_read_wf()
!
USE kinds, ONLY : dp
USE io_global, ONLY : stdout
USE klist, ONLY : nks, xk, npw_k=>ngk, igk_k
USE klist, ONLY : nks, xk, ngk, igk_k
USE gvect, ONLY : ngm, g
USE io_files, ONLY : nwordwfc, iunwfc, prefix, diropn,&
& tmp_dir, wfc_dir
@ -188,9 +188,9 @@ SUBROUTINE normal_read()
!
ELSE
!
CALL calbec(npw_k(1),vkb,evc0(:,:,1),becp_1)
CALL calbec(ngk(1),vkb,evc0(:,:,1),becp_1)
becp%r = becp_1
CALL s_psi(npwx, npw_k(1), nbnd, evc0(:,:,1), sevc0(:,:,1))
CALL s_psi(npwx, ngk(1), nbnd, evc0(:,:,1), sevc0(:,:,1))
!
ENDIF
!
@ -200,10 +200,10 @@ SUBROUTINE normal_read()
!
DO ik = 1, nks
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(npw_k(ik),vkb,evc0(:,:,ik),becp1_c(:,:,ik))
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(ngk(ik),vkb,evc0(:,:,ik),becp1_c(:,:,ik))
becp%k = becp1_c(:,:,ik)
CALL s_psi (npwx, npw_k(ik), nbnd, evc0(:,:,ik), sevc0(:,:,ik))
CALL s_psi (npwx, ngk(ik), nbnd, evc0(:,:,ik), sevc0(:,:,ik))
!
ENDDO
!
@ -259,7 +259,7 @@ SUBROUTINE normal_read()
!
DO ik = 1, nks
DO ibnd = 1, nbnd
DO ig = 1, npw_k(ik)
DO ig = 1, ngk(ik)
!
revc0(nls(igk_k(ig,ik)),ibnd,ik) = evc0(ig,ibnd,ik)
!
@ -401,9 +401,9 @@ SUBROUTINE virt_read()
ENDDO
!
ELSE
CALL calbec(npw_k(1),vkb,evc_all(:,:,1),becp1_all)
CALL calbec(ngk(1),vkb,evc_all(:,:,1),becp1_all)
becp%r=becp1_all
CALL s_psi(npwx, npw_k(1), nbnd, evc_all(:,:,1), sevc_all(:,:,1))
CALL s_psi(npwx, ngk(1), nbnd, evc_all(:,:,1), sevc_all(:,:,1))
ENDIF
!
ELSE
@ -412,10 +412,10 @@ SUBROUTINE virt_read()
!
DO ik = 1, nks
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(npw_k(ik),vkb,evc_all(:,:,ik),becp1_c_all(:,:,ik),nbnd)
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(ngk(ik),vkb,evc_all(:,:,ik),becp1_c_all(:,:,ik),nbnd)
becp%k=becp1_c_all(:,:,ik)
CALL s_psi (npwx, npw_k(ik), nbnd, evc_all(:,:,ik), sevc_all(:,:,ik))
CALL s_psi (npwx, ngk(ik), nbnd, evc_all(:,:,ik), sevc_all(:,:,ik))
!
ENDDO
!
@ -445,7 +445,7 @@ SUBROUTINE virt_read()
!
DO ibnd=1,nbnd,2
IF (ibnd<nbnd) THEN
DO ig=1,npw_k(1)
DO ig=1,ngk(1)
!
revc_all(nls(igk_k(ig,1)),ibnd,1) = evc_all(ig,ibnd,1)&
&+(0.0d0,1.0d0)*evc_all(ig,ibnd+1,1)
@ -455,7 +455,7 @@ SUBROUTINE virt_read()
!
ENDDO
ELSE
DO ig=1,npw_k(1)
DO ig=1,ngk(1)
!
revc_all(nls(igk_k(ig,1)),ibnd,1) = evc_all(ig,ibnd,1)
revc_all(nlsm(igk_k(ig,1)),ibnd,1) = CONJG(evc_all(ig,ibnd,1))
@ -473,7 +473,7 @@ SUBROUTINE virt_read()
!
DO ik=1,nks
DO ibnd=1,nbnd
DO ig=1,npw_k(ik)
DO ig=1,ngk(ik)
!
revc_all(nls(igk_k(ig,ik)),ibnd,ik) = evc_all(ig,ibnd,ik)
!

3
TDDFPT/src/lr_readin.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -144,7 +144,6 @@ SUBROUTINE lr_readin
plot_type = 1
project = .FALSE.
max_seconds = 1.0E+7_DP
eig_dir='./'
scissor = 0.d0
ecutfock = -1d0
!

26
TDDFPT/src/lr_restart.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -17,7 +17,7 @@ SUBROUTINE lr_restart(iter_restart,rflag)
USE kinds, ONLY : DP
USE io_global, ONLY : stdout, ionode_id
USE control_flags, ONLY : gamma_only
USE klist, ONLY : nks, xk, npw_k=>ngk, igk_k
USE klist, ONLY : nks, xk, ngk, igk_k
USE cell_base, ONLY : tpiba2
USE gvect, ONLY : g
USE io_files, ONLY : tmp_dir, prefix, diropn, wfc_dir
@ -257,15 +257,15 @@ SUBROUTINE lr_recalc_sevc1_new_optical()
enddo
!
else
call calbec(npw_k(1),vkb,evc1_new(:,:,1,1),becp)
call s_psi(npwx,npw_k(1),nbnd,evc1_new(:,:,1,1),sevc1_new(:,:,1,1))
call calbec(ngk(1),vkb,evc1_new(:,:,1,1),becp)
call s_psi(npwx,ngk(1),nbnd,evc1_new(:,:,1,1),sevc1_new(:,:,1,1))
endif
!
else
!
! nkb = 0, not real space
!
call s_psi(npwx,npw_k(1),nbnd,evc1_new(:,:,1,1),sevc1_new(:,:,1,1))
call s_psi(npwx,ngk(1),nbnd,evc1_new(:,:,1,1),sevc1_new(:,:,1,1))
!
endif
!
@ -285,15 +285,15 @@ SUBROUTINE lr_recalc_sevc1_new_optical()
enddo
!
else
call calbec(npw_k(1),vkb,evc1_new(:,:,1,2),becp%r)
call s_psi(npwx,npw_k(1),nbnd,evc1_new(:,:,1,2),sevc1_new(:,:,1,2))
call calbec(ngk(1),vkb,evc1_new(:,:,1,2),becp%r)
call s_psi(npwx,ngk(1),nbnd,evc1_new(:,:,1,2),sevc1_new(:,:,1,2))
endif
!
else
!
! nkb = 0, not real space
!
call s_psi(npwx,npw_k(1),nbnd,evc1_new(:,:,1,2),sevc1_new(:,:,1,2))
call s_psi(npwx,ngk(1),nbnd,evc1_new(:,:,1,2),sevc1_new(:,:,1,2))
!
endif
!
@ -305,16 +305,16 @@ SUBROUTINE lr_recalc_sevc1_new_optical()
!
if ( nkb > 0 .and. okvan ) then
!
call init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
call calbec(npw_k(ik), vkb, evc1_new(:,:,ik,1), becp)
call init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
call calbec(ngk(ik), vkb, evc1_new(:,:,ik,1), becp)
!
endif
!
call s_psi(npwx,npw_k(ik),nbnd,evc1_new(:,:,ik,1),sevc1_new(:,:,ik,1))
call s_psi(npwx,ngk(ik),nbnd,evc1_new(:,:,ik,1),sevc1_new(:,:,ik,1))
!
if (nkb > 0 .and. okvan) call calbec(npw_k(ik), vkb, evc1_new(:,:,ik,2),becp)
if (nkb > 0 .and. okvan) call calbec(ngk(ik), vkb, evc1_new(:,:,ik,2),becp)
!
call s_psi(npwx,npw_k(ik),nbnd,evc1_new(:,:,ik,2),sevc1_new(:,:,ik,2))
call s_psi(npwx,ngk(ik),nbnd,evc1_new(:,:,ik,2),sevc1_new(:,:,ik,2))
!
enddo
!

10
TDDFPT/src/lr_sm1_psi.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -265,7 +265,7 @@ CONTAINS
! Optical case : k-points version
!
USE becmod, ONLY : bec_type,becp,calbec
USE klist, ONLY : nks, xk, npw_k=>ngk, igk_k
USE klist, ONLY : nks, xk, ngk, igk_k
!
IMPLICIT NONE
!
@ -306,12 +306,12 @@ CONTAINS
!
! Calculate beta-functions vkb for a given k point.
!
CALL init_us_2(npw_k(ik1),igk_k(:,ik1),xk(1,ik1),vkb)
CALL init_us_2(ngk(ik1),igk_k(:,ik1),xk(1,ik1),vkb)
!
! Calculate the coefficients B_ij defined by Eq.(15).
! B_ij = <beta(i)|beta(j)>, where beta(i) = vkb(i).
!
CALL zgemm('C','N',nkb,nkb,npw_k(ik1),(1.d0,0.d0),vkb,lda,vkb,lda,(0.d0,0.d0),BB_(1,1,ik1),nkb)
CALL zgemm('C','N',nkb,nkb,ngk(ik1),(1.d0,0.d0),vkb,lda,vkb,lda,(0.d0,0.d0),BB_(1,1,ik1),nkb)
!
#ifdef __MPI
CALL mp_sum(BB_(:,:,ik1), intra_bgrp_comm)
@ -393,7 +393,7 @@ CONTAINS
!
! Calculate beta-functions vkb for a given k point 'ik'.
!
CALL init_us_2(npw_k(ik),igk_k(:,ik),xk(1,ik),vkb)
CALL init_us_2(ngk(ik),igk_k(:,ik),xk(1,ik),vkb)
!
! Compute the product of the beta-functions vkb with the functions psi
! at point k, and put the result in becp%k.

6
TDDFPT/src/lr_solve_e.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -24,7 +24,7 @@ SUBROUTINE lr_solve_e
USE gvect, ONLY : gstart
USE io_global, ONLY : stdout
USE io_files, ONLY : diropn, tmp_dir, wfc_dir
USE klist, ONLY : nks, xk, npw_k=>ngk, igk_k, degauss
USE klist, ONLY : nks, xk, ngk, igk_k, degauss
USE lr_variables, ONLY : nwordd0psi, iund0psi,LR_polarization, test_case_no, &
& n_ipol, evc0, d0psi, d0psi2, evc1, lr_verbosity, &
& d0psi_rs, eels
@ -79,7 +79,7 @@ SUBROUTINE lr_solve_e
!
! Ultrasoft case: calculate beta-functions vkb.
!
npw = npw_k(ik)
npw = ngk(ik)
igk(:) = igk_k(:,ik)
!
CALL init_us_2(npw,igk,xk(1,ik),vkb)

10
TDDFPT/src/lr_us.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -23,7 +23,7 @@ SUBROUTINE lr_apply_s(vect, svect)
USE io_global, ONLY : stdout
USE uspp, ONLY : okvan, vkb, nkb
USE wvfct, ONLY : npwx, npw, nbnd
USE klist, ONLY : nks, xk, npw_k=>ngk, igk_k
USE klist, ONLY : nks, xk, ngk, igk_k
USE becmod, ONLY : becp, calbec
USE noncollin_module, ONLY : npol
USE lr_variables, ONLY : eels, lr_verbosity
@ -104,9 +104,9 @@ SUBROUTINE lr_apply_s_optical()
!
DO ik = 1, nksq
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(npw_k(ik),vkb,vect(:,:,ik),becp)
CALL s_psi(npwx,npw_k(ik),nbnd,vect(1,1,ik),svect(1,1,ik))
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(ngk(ik),vkb,vect(:,:,ik),becp)
CALL s_psi(npwx,ngk(ik),nbnd,vect(1,1,ik),svect(1,1,ik))
!
ENDDO
!

18
TDDFPT/src/lr_variables.f90
View File

@ -27,26 +27,8 @@ MODULE lr_variables
INTEGER :: size_evc
CHARACTER (len=24) :: bgz_suffix
!
!------------------------------------------------------------------------!
! Variables for TD-HF using Dario Rocca's BSE routines.
!------------------------------------------------------------------------!
!
LOGICAL :: lr_exx
REAL(kind=dp), ALLOCATABLE :: xkk_m(:,:), xkk_p(:,:), weight_kk(:)
REAL(kind=dp) :: exxdiv
REAL(kind=dp) :: ecutfock_
! REAL(kind=dp), ALLOCATABLE :: revc_int(:,:)
! COMPLEX(kind=dp), ALLOCATABLE :: revc_int_c(:,:,:)
!
INTEGER, ALLOCATABLE :: &
igkk_kk_m(:,:),&
npw_kk_m(:), &
ind_kk_m(:,:), &
igkk_kk_p(:,:),&
npw_kk_p(:), &
ind_kk_p(:,:)
REAL(kind=dp) :: scissor
CHARACTER(len=200) :: eig_dir
!
!------------------------------------------------------------------------!
! Variables for EELS

14
TDDFPT/src/sd0psi.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2015 Quantum ESPRESSO group
! Copyright (C) 2001-2016 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,
@ -16,7 +16,7 @@ SUBROUTINE sd0psi()
! Modified by Osman Baris Malcioglu (2009)
! Modified by Iurii Timrov (EELS extension) (2013)
!
USE klist, ONLY : nks, xk, npw_k=>ngk, igk_k
USE klist, ONLY : nks, xk, ngk, igk_k
USE lr_variables, ONLY : n_ipol, d0psi, lr_verbosity, eels
USE uspp, ONLY : vkb, nkb, okvan
USE wvfct, ONLY : nbnd, npwx
@ -76,8 +76,8 @@ SUBROUTINE lr_sd0psi_optical()
!
ELSE
!
CALL calbec(npw_k(1),vkb,d0psi(:,:,1,ip),becp)
CALL s_psi(npwx,npw_k(1),nbnd,d0psi(:,:,1,ip),d0psi(:,:,1,ip))
CALL calbec(ngk(1),vkb,d0psi(:,:,1,ip),becp)
CALL s_psi(npwx,ngk(1),nbnd,d0psi(:,:,1,ip),d0psi(:,:,1,ip))
!
ENDIF
!
@ -85,9 +85,9 @@ SUBROUTINE lr_sd0psi_optical()
!
DO ik = 1, nksq
!
CALL init_us_2(npw_k(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(npw_k(ik),vkb,d0psi(:,:,ik,ip),becp)
CALL s_psi(npwx,npw_k(ik),nbnd,d0psi(:,:,ik,ip),d0psi(:,:,ik,ip))
CALL init_us_2(ngk(ik),igk_k(1,ik),xk(1,ik),vkb)
CALL calbec(ngk(ik),vkb,d0psi(:,:,ik,ip),becp)
CALL s_psi(npwx,ngk(ik),nbnd,d0psi(:,:,ik,ip),d0psi(:,:,ik,ip))
!
ENDDO
!

2
TDDFPT/src/stop_lr.f90
View File

@ -174,8 +174,6 @@ SUBROUTINE stop_lr( full_run )
CLOSE( UNIT = iuwfc, STATUS = 'KEEP' )
ENDIF
!
!CLOSE( UNIT = iunigk, STATUS = 'KEEP' )
!
STOP
!
END SUBROUTINE stop_lr