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

Update to EPW USPP to support time-reversal symm. 

Courtesy of R. Margine.
This commit is contained in:
Samuel Ponce 2019-02-04 18:02:45 +00:00
parent 92d7ce5df2
commit c2ef20a5e7
12 changed files with 435 additions and 396 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
EPW/src/adddvscf2.f90
View File

@ -67,9 +67,9 @@
INTEGER :: ijs INTEGER :: ijs
!! Counter on combined is and js polarization !! Counter on combined is and js polarization
! !
COMPLEX(DP) :: sumA COMPLEX(kind=DP) :: sum_k
!! auxiliary sum variable !! auxiliary sum variable
COMPLEX(DP) :: sum_nc(npol) COMPLEX(kind=DP) :: sum_nc(npol)
!! auxiliary sum variable non-collinear case !! auxiliary sum variable non-collinear case
! !
IF (.not.okvan) RETURN IF (.not.okvan) RETURN
@ -87,12 +87,12 @@
! we multiply the integral for the becp term and the beta_n ! we multiply the integral for the becp term and the beta_n
! !
DO ibnd = lower_band, upper_band DO ibnd = lower_band, upper_band
do ih = 1, nh(nt) DO ih = 1, nh(nt)
ikb = ijkb0 + ih ikb = ijkb0 + ih
IF (noncolin) THEN IF (noncolin) THEN
sum_nc = czero sum_nc = czero
ELSE ELSE
sumA = czero sum_k = czero
ENDIF ENDIF
DO jh = 1, nh(nt) DO jh = 1, nh(nt)
jkb = ijkb0 + jh jkb = ijkb0 + jh
@ -106,7 +106,7 @@
ENDDO ENDDO
ENDDO ENDDO
ELSE ELSE
sumA = sumA + int3(ih,jh,na,current_spin,ipert) * & sum_k = sum_k + int3(ih,jh,na,current_spin,ipert) * &
becp1(ik)%k(jkb,ibnd) becp1(ik)%k(jkb,ibnd)
ENDIF ENDIF
ENDDO ENDDO
@ -114,7 +114,7 @@
CALL zaxpy( npwq, sum_nc(1), vkb(1,ikb), 1, dvpsi(1,ibnd), 1 ) CALL zaxpy( npwq, sum_nc(1), vkb(1,ikb), 1, dvpsi(1,ibnd), 1 )
CALL zaxpy( npwq, sum_nc(2), vkb(1,ikb), 1, dvpsi(1+npwx,ibnd), 1 ) CALL zaxpy( npwq, sum_nc(2), vkb(1,ikb), 1, dvpsi(1+npwx,ibnd), 1 )
ELSE ELSE
CALL zaxpy( npwq, sumA, vkb(1,ikb), 1, dvpsi(1,ibnd), 1 ) CALL zaxpy( npwq, sum_k, vkb(1,ikb), 1, dvpsi(1,ibnd), 1 )
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO

10
EPW/src/allocate_epwq.f90
View File

@ -25,10 +25,10 @@
USE gvect, ONLY : ngm USE gvect, ONLY : ngm
USE noncollin_module, ONLY : noncolin, npol, nspin_mag USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE spin_orb, ONLY : lspinorb USE spin_orb, ONLY : lspinorb
USE phcom, ONLY : evq, dpsi, vlocq, dmuxc USE phcom, ONLY : evq, vlocq, dmuxc
USE phus, ONLY : int1, int1_nc, int2, int2_so, & USE phus, ONLY : int1, int1_nc, int2, int2_so, &
int4, int4_nc, int5, int5_so, becsum_nc, & int4, int4_nc, int5, int5_so, &
alphasum, alphasum_nc, alphap alphap
USE lr_symm_base, ONLY : rtau USE lr_symm_base, ONLY : rtau
USE qpoint, ONLY : eigqts USE qpoint, ONLY : eigqts
USE lrus, ONLY : becp1 USE lrus, ONLY : becp1
@ -52,7 +52,6 @@
! ALLOCATE space for the quantities needed in EPW ! ALLOCATE space for the quantities needed in EPW
! !
ALLOCATE (evq(npwx*npol, nbnd)) ALLOCATE (evq(npwx*npol, nbnd))
ALLOCATE (dpsi ( npwx*npol, nbnd))
ALLOCATE (transp_temp(nstemp)) ALLOCATE (transp_temp(nstemp))
! !
ALLOCATE (vlocq(ngm, ntyp)) ALLOCATE (vlocq(ngm, ntyp))
@ -82,14 +81,11 @@
IF (noncolin) THEN IF (noncolin) THEN
ALLOCATE (int1_nc(nhm, nhm, 3, nat, nspin)) ALLOCATE (int1_nc(nhm, nhm, 3, nat, nspin))
ALLOCATE (int4_nc(nhm, nhm, 3, 3, nat, nspin)) ALLOCATE (int4_nc(nhm, nhm, 3, 3, nat, nspin))
ALLOCATE (becsum_nc(nhm*(nhm+1)/2, nat, npol, npol))
ALLOCATE (alphasum_nc(nhm*(nhm+1)/2, 3, nat, npol, npol))
IF (lspinorb) THEN IF (lspinorb) THEN
ALLOCATE (int2_so(nhm, nhm, 3, nat, nat, nspin)) ALLOCATE (int2_so(nhm, nhm, 3, nat, nat, nspin))
ALLOCATE (int5_so(nhm, nhm, 3, 3, nat, nat, nspin)) ALLOCATE (int5_so(nhm, nhm, 3, 3, nat, nat, nspin))
ENDIF ENDIF
ENDIF ! noncolin ENDIF ! noncolin
ALLOCATE (alphasum(nhm * (nhm + 1)/2, 3, nat, nspin_mag))
ENDIF ENDIF
! !
ALLOCATE (becp1(nks)) ALLOCATE (becp1(nks))

40
EPW/src/close_epw.f90
View File

@ -104,9 +104,7 @@
!! Imported the noncolinear case implemented by xlzhang !! Imported the noncolinear case implemented by xlzhang
!! !!
!---------------------------------------------------------------------- !----------------------------------------------------------------------
USE phcom, ONLY : alphap, alphasum, alphasum_nc, & USE phcom, ONLY : alphap, dmuxc, drc, dyn, evq, dvpsi, &
becsum_nc, dmuxc, dpsi,&
drc, dpsi, dyn, evq, dvpsi,&
int5, vlocq, int2_so, int5_so int5, vlocq, int2_so, int5_so
USE lrus, ONLY : becp1, int3, int3_nc USE lrus, ONLY : becp1, int3, int3_nc
USE phus, ONLY : int1, int1_nc, int2, int4, int4_nc USE phus, ONLY : int1, int1_nc, int2, int4, int4_nc
@ -154,7 +152,6 @@
IF(ASSOCIATED(igkq)) DEALLOCATE(igkq) IF(ASSOCIATED(igkq)) DEALLOCATE(igkq)
! !
IF(ALLOCATED(dvpsi)) DEALLOCATE (dvpsi) IF(ALLOCATED(dvpsi)) DEALLOCATE (dvpsi)
IF(ALLOCATED(dpsi)) DEALLOCATE ( dpsi)
! !
IF(ALLOCATED(vlocq)) DEALLOCATE (vlocq) IF(ALLOCATED(vlocq)) DEALLOCATE (vlocq)
IF(ALLOCATED(dmuxc)) DEALLOCATE (dmuxc) IF(ALLOCATED(dmuxc)) DEALLOCATE (dmuxc)
@ -178,28 +175,25 @@
IF(ALLOCATED(int1_nc)) DEALLOCATE(int1_nc) IF(ALLOCATED(int1_nc)) DEALLOCATE(int1_nc)
IF(ALLOCATED(int3_nc)) DEALLOCATE(int3_nc) IF(ALLOCATED(int3_nc)) DEALLOCATE(int3_nc)
IF(ALLOCATED(int4_nc)) DEALLOCATE(int4_nc) IF(ALLOCATED(int4_nc)) DEALLOCATE(int4_nc)
IF(ALLOCATED(becsum_nc)) DEALLOCATE(becsum_nc)
IF(ALLOCATED(alphasum_nc)) DEALLOCATE(alphasum_nc)
IF(ALLOCATED(int2_so)) DEALLOCATE(int2_so) IF(ALLOCATED(int2_so)) DEALLOCATE(int2_so)
IF(ALLOCATED(int5_so)) DEALLOCATE(int5_so) IF(ALLOCATED(int5_so)) DEALLOCATE(int5_so)
IF(ALLOCATED(alphasum)) DEALLOCATE (alphasum)
! !
if(allocated(alphap)) then IF (allocated(alphap)) THEN
do ik=1,nks DO ik = 1, nks
do ipol=1,3 DO ipol = 1, 3
call deallocate_bec_type ( alphap(ipol,ik) ) CALL deallocate_bec_type( alphap(ipol,ik) )
enddo ENDDO
end do ENDDO
deallocate (alphap) DEALLOCATE(alphap)
endif ENDIF
if(allocated(becp1)) then IF (allocated(becp1)) THEN
do ik=1,size(becp1) DO ik = 1, size(becp1)
call deallocate_bec_type ( becp1(ik) ) CALL deallocate_bec_type( becp1(ik) )
end do ENDDO
deallocate(becp1) DEALLOCATE(becp1)
end if ENDIF
call deallocate_bec_type ( becp ) CALL deallocate_bec_type ( becp )
!
IF(ALLOCATED(nbnd_occ)) DEALLOCATE(nbnd_occ) IF(ALLOCATED(nbnd_occ)) DEALLOCATE(nbnd_occ)
IF(ALLOCATED(m_loc)) DEALLOCATE(m_loc) IF(ALLOCATED(m_loc)) DEALLOCATE(m_loc)
! !

116
EPW/src/dvanqq2.f90
View File

@ -15,10 +15,16 @@
!! !!
!! New !! New
!! This routine calculates two integrals of the Q functions and !! This routine calculates two integrals of the Q functions and
!! its derivatives with c V_loc and V_eff which are used !! its derivatives with V_loc and V_eff which are used
!! to compute term dV_bare/dtau * psi in addusdvqpsi. !! to compute term dV_bare/dtau * psi in addusdvqpsi.
!! The result is stored in int1, int2, int4, int5. The routine is called !! The result is stored in int1, int2, int4, int5. The routine is called
!! for each q in nqc. !! for each q in nqc.
!! int1 -> Eq. B20 of Ref.[1]
!! int2 -> Eq. B21 of Ref.[1]
!! int4 -> Eq. B23 of Ref.[1]
!! int5 -> Eq. B24 of Ref.[1]
!!
!! [1] PRB 64, 235118 (2001).
!! !!
!! RM - Nov/Dec 2014 !! RM - Nov/Dec 2014
!! Imported the noncolinear case implemented by xlzhang !! Imported the noncolinear case implemented by xlzhang
@ -73,19 +79,27 @@
INTEGER :: is INTEGER :: is
!! counter on spin !! counter on spin
! !
REAL(DP), ALLOCATABLE :: qmod(:) REAL(kind=DP), ALLOCATABLE :: qmod(:)
!! the modulus of q+G !! the modulus of q+G
REAL(DP), ALLOCATABLE :: qmodg(:) REAL(kind=DP), ALLOCATABLE :: qmodg(:)
!! the modulus of G !! the modulus of G
REAL(DP), ALLOCATABLE :: qpg(:,:) REAL(DP), ALLOCATABLE :: qpg(:,:)
!! the q+G vectors !! the q+G vectors
REAL(DP), ALLOCATABLE :: ylmkq(:,:), ylmk0(:,:) REAL(kind=DP), ALLOCATABLE :: ylmkq(:,:)
!! the spherical harmonics !! the spherical harmonics at q+G
REAL(kind=DP), ALLOCATABLE :: ylmk0(:,:)
!! the spherical harmonics at G
! !
COMPLEX(kind=DP) :: fact, fact1, ZDOTC COMPLEX(kind=DP) :: fact
!! e^{-i q * \tau} * conjg(e^{-i q * \tau})
COMPLEX(kind=DP) :: fact1
!! -i * omega
COMPLEX(kind=DP), EXTERNAL :: zdotc
!! the scalar product function
COMPLEX(kind=DP), ALLOCATABLE :: aux1(:), aux2(:), & COMPLEX(kind=DP), ALLOCATABLE :: aux1(:), aux2(:), &
aux3(:), aux5(:), veff(:,:), sk(:) aux3(:), aux5(:), sk(:)
! work space COMPLEX(kind=DP), ALLOCATABLE :: veff(:,:)
!! effective potential
COMPLEX(kind=DP), ALLOCATABLE, TARGET :: qgm(:) COMPLEX(kind=DP), ALLOCATABLE, TARGET :: qgm(:)
!! the augmentation function at G !! the augmentation function at G
COMPLEX(kind=DP), POINTER :: qgmq(:) COMPLEX(kind=DP), POINTER :: qgmq(:)
@ -105,11 +119,11 @@
ALLOCATE( aux3(ngm) ) ALLOCATE( aux3(ngm) )
ALLOCATE( aux5(ngm) ) ALLOCATE( aux5(ngm) )
ALLOCATE( qmodg(ngm) ) ALLOCATE( qmodg(ngm) )
ALLOCATE (ylmk0( ngm, lmaxq * lmaxq))
ALLOCATE (qgm ( ngm))
ALLOCATE (ylmkq( ngm, lmaxq * lmaxq))
ALLOCATE( qmod(ngm) ) ALLOCATE( qmod(ngm) )
ALLOCATE( qgmq(ngm) ) ALLOCATE( qgmq(ngm) )
ALLOCATE( qgm(ngm))
ALLOCATE( ylmk0(ngm, lmaxq * lmaxq) )
ALLOCATE( ylmkq(ngm, lmaxq * lmaxq) )
! !
! compute spherical harmonics ! compute spherical harmonics
! !
@ -148,6 +162,7 @@
! !
DO ntb = 1, ntyp DO ntb = 1, ntyp
IF (upf(ntb)%tvanp ) THEN IF (upf(ntb)%tvanp ) THEN
!
DO ih = 1, nh(ntb) DO ih = 1, nh(ntb)
DO jh = ih, nh(ntb) DO jh = ih, nh(ntb)
ijh = ijtoh(ih,jh,ntb) ijh = ijtoh(ih,jh,ntb)
@ -167,8 +182,9 @@
* eigts2(mill(2,ig),nb) & * eigts2(mill(2,ig),nb) &
* eigts3(mill(3,ig),nb) * eigts3(mill(3,ig),nb)
ENDDO ENDDO
!
DO na = 1, nat DO na = 1, nat
fact = eigqts(na) * CONJG( eigqts(nb) ) fact = eigqts(na) * conjg( eigqts(nb) )
! !
! nb is the atom of the augmentation function ! nb is the atom of the augmentation function
! !
@ -178,12 +194,14 @@
* eigts2(mill(2,ig),na) & * eigts2(mill(2,ig),na) &
* eigts3(mill(3,ig),na) * eigts3(mill(3,ig),na)
ENDDO ENDDO
!
DO ipol = 1, 3 DO ipol = 1, 3
DO ig = 1, ngm DO ig = 1, ngm
aux5(ig) = sk(ig) * ( g(ipol,ig) + xq(ipol) ) aux5(ig) = sk(ig) * ( g(ipol,ig) + xq(ipol) )
ENDDO ENDDO
int2(ih,jh,ipol,na,nb) = fact * fact1 * & int2(ih,jh,ipol,na,nb) = fact * fact1 * &
ZDOTC(ngm, aux1, 1, aux5, 1) zdotc(ngm, aux1, 1, aux5, 1)
!
DO jpol = 1, 3 DO jpol = 1, 3
IF (jpol >= ipol) THEN IF (jpol >= ipol) THEN
DO ig = 1, ngm DO ig = 1, ngm
@ -191,45 +209,51 @@
( g(jpol,ig) + xq(jpol) ) ( g(jpol,ig) + xq(jpol) )
ENDDO ENDDO
int5(ijh,ipol,jpol,na,nb) = & int5(ijh,ipol,jpol,na,nb) = &
CONJG(fact) * tpiba2 * omega * & conjg(fact) * tpiba2 * omega * &
ZDOTC(ngm, aux3, 1, aux1, 1) zdotc(ngm, aux3, 1, aux1, 1)
ELSE ELSE
int5(ijh,ipol,jpol,na,nb) = & int5(ijh,ipol,jpol,na,nb) = &
int5(ijh,jpol,ipol,na,nb) int5(ijh,jpol,ipol,na,nb)
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO !ipol
ENDDO !
ENDDO !na
!
DO ig = 1, ngm DO ig = 1, ngm
aux1(ig) = qgm(ig) * eigts1(mill(1,ig),nb) & aux1(ig) = qgm(ig) * eigts1(mill(1,ig),nb) &
* eigts2(mill(2,ig),nb) & * eigts2(mill(2,ig),nb) &
* eigts3(mill(3,ig),nb) * eigts3(mill(3,ig),nb)
ENDDO ENDDO
!
DO is = 1, nspin_mag DO is = 1, nspin_mag
DO ipol = 1, 3 DO ipol = 1, 3
DO ig = 1, ngm DO ig = 1, ngm
aux2(ig) = veff(dfftp%nl(ig),is) * g(ipol,ig) aux2(ig) = veff(dfftp%nl(ig),is) * g(ipol,ig)
ENDDO ENDDO
int1(ih,jh,ipol,nb,is) = - fact1 * & int1(ih,jh,ipol,nb,is) = - fact1 * &
ZDOTC(ngm, aux1, 1, aux2, 1) zdotc(ngm, aux1, 1, aux2, 1)
DO jpol = 1, 3 DO jpol = 1, 3
IF (jpol >= ipol) THEN IF (jpol >= ipol) THEN
DO ig = 1, ngm DO ig = 1, ngm
aux3(ig) = aux2(ig) * g(jpol,ig) aux3(ig) = aux2(ig) * g(jpol,ig)
ENDDO ENDDO
int4(ijh,ipol,jpol,nb,is) = - tpiba2 * & int4(ijh,ipol,jpol,nb,is) = - tpiba2 * &
omega * ZDOTC(ngm, aux3, 1, aux1, 1) omega * zdotc(ngm, aux3, 1, aux1, 1)
ELSE ELSE
int4(ijh,ipol,jpol,nb,is) = & int4(ijh,ipol,jpol,nb,is) = &
int4(ijh,jpol,ipol,nb,is) int4(ijh,jpol,ipol,nb,is)
ENDIF ENDIF
ENDDO ENDDO ! jpol
ENDDO ENDDO ! ipol
ENDDO ENDDO ! is
ENDIF !
ENDDO ENDIF ! ityp
ENDDO ENDDO ! nb
ENDDO !
ENDDO ! jh
ENDDO ! ih
!
DO ih = 1, nh(ntb) DO ih = 1, nh(ntb)
DO jh = ih + 1, nh(ntb) DO jh = ih + 1, nh(ntb)
! !
@ -247,14 +271,17 @@
ENDDO ENDDO
ENDIF ENDIF
ENDDO ENDDO
ENDDO !
ENDDO ENDDO ! jh
ENDIF ENDDO ! ih
ENDDO !
ENDIF ! upf
ENDDO ! ntb
CALL mp_sum(int1, intra_pool_comm) CALL mp_sum(int1, intra_pool_comm)
CALL mp_sum(int2, intra_pool_comm) CALL mp_sum(int2, intra_pool_comm)
CALL mp_sum(int4, intra_pool_comm) CALL mp_sum(int4, intra_pool_comm)
CALL mp_sum(int5, intra_pool_comm) CALL mp_sum(int5, intra_pool_comm)
!
IF (noncolin) THEN IF (noncolin) THEN
CALL set_int12_nc(0) CALL set_int12_nc(0)
int4_nc = czero int4_nc = czero
@ -276,18 +303,29 @@
ENDDO ENDDO
ENDIF ENDIF
! !
DEALLOCATE (veff) !DBRM
DEALLOCATE (qgmq) !write(*,'(a,e20.12)') 'int1 = ', &
!SUM((REAL(REAL(int1(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int1(:,:,:,:,:))))**2)
!write(*,'(a,e20.12)') 'int2 = ', &
!SUM((REAL(REAL(int2(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int2(:,:,:,:,:))))**2)
!write(*,'(a,e20.12)') 'int4 = ', &
!SUM((REAL(REAL(int4(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int4(:,:,:,:,:))))**2)
!write(*,'(a,e20.12)') 'int5 = ', &
!SUM((REAL(REAL(int5(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int5(:,:,:,:,:))))**2)
!END
!
DEALLOCATE(sk)
DEALLOCATE(aux1)
DEALLOCATE(aux2)
DEALLOCATE(aux3)
DEALLOCATE(aux5)
DEALLOCATE(qmodg)
DEALLOCATE(qmod) DEALLOCATE(qmod)
DEALLOCATE (ylmkq) DEALLOCATE(qgmq)
DEALLOCATE(qgm) DEALLOCATE(qgm)
DEALLOCATE(ylmk0) DEALLOCATE(ylmk0)
DEALLOCATE (qmodg) DEALLOCATE(ylmkq)
DEALLOCATE (aux5) DEALLOCATE(veff)
DEALLOCATE (aux3)
DEALLOCATE (aux2)
DEALLOCATE (aux1)
DEALLOCATE (sk)
! !
CALL stop_clock ('dvanqq2') CALL stop_clock ('dvanqq2')
RETURN RETURN

42
EPW/src/dvqpsi_us3.f90
View File

@ -10,7 +10,7 @@
! adapted from PH/dvqpsi_us (QE) ! adapted from PH/dvqpsi_us (QE)
! !
!---------------------------------------------------------------------- !----------------------------------------------------------------------
SUBROUTINE dvqpsi_us3( ik, uact, addnlcc, xxk, xq0 ) SUBROUTINE dvqpsi_us3( ik, uact, addnlcc, xxkq, xq0 )
!---------------------------------------------------------------------- !----------------------------------------------------------------------
!! !!
!! This routine calculates dV_bare/dtau * psi for one perturbation !! This routine calculates dV_bare/dtau * psi for one perturbation
@ -59,8 +59,8 @@
! !
REAL(kind=DP), INTENT (in) :: xq0(3) REAL(kind=DP), INTENT (in) :: xq0(3)
!! Current coarse q-point coordinate !! Current coarse q-point coordinate
REAL(kind=DP), INTENT (in) :: xxk(3) REAL(kind=DP), INTENT (in) :: xxkq(3)
!! k-point coordinate !! k+q point coordinate
! !
COMPLEX(kind=DP), INTENT(in) :: uact(3 * nat) COMPLEX(kind=DP), INTENT(in) :: uact(3 * nat)
!! the pattern of displacements !! the pattern of displacements
@ -86,14 +86,24 @@
INTEGER :: npw INTEGER :: npw
!! Number of k+G-vectors inside 'ecut sphere' !! Number of k+G-vectors inside 'ecut sphere'
! !
REAL(DP) :: fac REAL(kind=DP) :: fac
!! spin degeneracy factor !! spin degeneracy factor
! !
COMPLEX(DP) :: gtau, gu, fact, u1, u2, u3, gu0 COMPLEX(kind=DP) :: gtau
COMPLEX(DP), ALLOCATABLE, TARGET :: aux(:) !! e^{-i G * \tau}
COMPLEX(DP), ALLOCATABLE :: aux1(:), aux2(:) COMPLEX(kind=DP) :: u1, u2, u3
COMPLEX(DP), POINTER :: auxs(:) !! components of displacement pattern u
COMPLEX(DP), ALLOCATABLE :: drhoc(:) COMPLEX(kind=DP) :: gu0
!! scalar product q * u
COMPLEX(kind=DP) :: gu
!! q * u + G * u
COMPLEX(kind=DP) :: fact
!! e^{-i q * \tau}
COMPLEX(kind=DP), ALLOCATABLE, TARGET :: aux(:)
COMPLEX(kind=DP), ALLOCATABLE :: aux1(:), aux2(:)
COMPLEX(kind=DP), POINTER :: auxs(:)
COMPLEX(kind=DP), ALLOCATABLE :: drhoc(:)
!! response core charge density
! !
CALL start_clock('dvqpsi_us3') CALL start_clock('dvqpsi_us3')
! !
@ -117,14 +127,16 @@
DO na = 1, nat DO na = 1, nat
fact = tpiba * (0.d0, -1.d0) * eigqts(na) fact = tpiba * (0.d0, -1.d0) * eigqts(na)
mu = 3 * (na - 1) mu = 3 * (na - 1)
IF (abs(uact(mu+1)) + abs(uact(mu+2)) + abs(uact(mu+3)) .gt. eps12) THEN
nt = ityp(na)
u1 = uact(mu+1) u1 = uact(mu+1)
u2 = uact(mu+2) u2 = uact(mu+2)
u3 = uact(mu+3) u3 = uact(mu+3)
IF (abs(u1) + abs(u2) + abs(u3) .gt. eps12) THEN
nt = ityp(na)
gu0 = xq0(1) * u1 + xq0(2) * u2 + xq0(3) * u3 gu0 = xq0(1) * u1 + xq0(2) * u2 + xq0(3) * u3
DO ig = 1, ngms DO ig = 1, ngms
gtau = eigts1(mill(1,ig),na) * eigts2(mill(2,ig),na) * eigts3(mill(3,ig),na) gtau = eigts1(mill(1,ig),na) * &
eigts2(mill(2,ig),na) * &
eigts3(mill(3,ig),na)
gu = gu0 + g(1,ig) * u1 + g(2,ig) * u2 + g(3,ig) * u3 gu = gu0 + g(1,ig) * u1 + g(2,ig) * u2 + g(3,ig) * u3
aux1(dffts%nl(ig)) = aux1(dffts%nl(ig)) + vlocq(ig,nt) * gu * fact * gtau aux1(dffts%nl(ig)) = aux1(dffts%nl(ig)) + vlocq(ig,nt) * gu * fact * gtau
ENDDO ENDDO
@ -138,11 +150,11 @@
DO na = 1, nat DO na = 1, nat
fact = tpiba * (0.d0, -1.d0) * eigqts(na) fact = tpiba * (0.d0, -1.d0) * eigqts(na)
mu = 3 * (na - 1) mu = 3 * (na - 1)
IF (abs(uact(mu+1)) + abs(uact(mu+2)) + abs(uact(mu+3)) .gt. eps12) THEN
nt = ityp(na)
u1 = uact(mu+1) u1 = uact(mu+1)
u2 = uact(mu+2) u2 = uact(mu+2)
u3 = uact(mu+3) u3 = uact(mu+3)
IF (abs(u1) + abs(u2) + abs(u3) .gt. eps12) THEN
nt = ityp(na)
gu0 = xq0(1) * u1 + xq0(2) * u2 + xq0(3) * u3 gu0 = xq0(1) * u1 + xq0(2) * u2 + xq0(3) * u3
IF (upf(nt)%nlcc) THEN IF (upf(nt)%nlcc) THEN
DO ig = 1,ngm DO ig = 1,ngm
@ -248,7 +260,7 @@
! First a term similar to the KB case. ! First a term similar to the KB case.
! Then a term due to the change of the D coefficients in the perturbat ! Then a term due to the change of the D coefficients in the perturbat
! !
CALL dvqpsi_us_only3( ik, uact, xxk ) CALL dvqpsi_us_only3( ik, uact, xxkq )
! !
CALL stop_clock('dvqpsi_us3') CALL stop_clock('dvqpsi_us3')
! !

112
EPW/src/dvqpsi_us_only3.f90
View File

@ -10,7 +10,7 @@
! adapted from PH/dvqpsi_us_only (QE) ! adapted from PH/dvqpsi_us_only (QE)
! !
!---------------------------------------------------------------------- !----------------------------------------------------------------------
subroutine dvqpsi_us_only3( ik, uact, xxk ) subroutine dvqpsi_us_only3( ik, uact, xxkq )
!---------------------------------------------------------------------- !----------------------------------------------------------------------
!! !!
!! This routine calculates dV_bare/dtau * psi for one perturbation !! This routine calculates dV_bare/dtau * psi for one perturbation
@ -41,11 +41,11 @@
IMPLICIT NONE IMPLICIT NONE
! !
INTEGER, INTENT(in) :: ik INTEGER, INTENT(in) :: ik
!! Input: the k point !! the k point
REAL(kind=DP), INTENT(in) :: xxk(3) REAL(kind=DP), INTENT(in) :: xxkq(3)
!! input: the k point (cartesian coordinates) !! the k+q point (cartesian coordinates)
COMPLEX(kind=DP), INTENT(in) :: uact(3 * nat) COMPLEX(kind=DP), INTENT(in) :: uact(3 * nat)
!! input: the pattern of displacements !! the pattern of displacements
! !
! Local variables ! Local variables
! !
@ -84,10 +84,10 @@
INTEGER :: ijs INTEGER :: ijs
!! Counter on combined is and js polarization !! Counter on combined is and js polarization
! !
REAL(DP), ALLOCATABLE :: deff(:,:,:) REAL(kind=DP), ALLOCATABLE :: deff(:,:,:)
! !
COMPLEX(DP), ALLOCATABLE :: ps1(:,:), ps2(:,:,:), aux(:), deff_nc(:,:,:,:) COMPLEX(kind=DP), ALLOCATABLE :: ps1(:,:), ps2(:,:,:), aux(:), deff_nc(:,:,:,:)
COMPLEX(DP), ALLOCATABLE :: ps1_nc(:,:,:), ps2_nc(:,:,:,:) COMPLEX(kind=DP), ALLOCATABLE :: ps1_nc(:,:,:), ps2_nc(:,:,:,:)
! !
LOGICAL :: ok LOGICAL :: ok
! !
@ -131,9 +131,7 @@
DO jh = 1, nh(nt) DO jh = 1, nh(nt)
jkb = ijkb0 + jh jkb = ijkb0 + jh
DO ipol = 1, 3 DO ipol = 1, 3
IF ( abs( uact(mu + 1) ) + & IF ( abs( uact(mu+1) ) + abs( uact(mu+2) ) + abs( uact(mu+3) ) > eps12 ) THEN
abs( uact(mu + 2) ) + &
abs( uact(mu + 3) ) > eps12 ) THEN
IF (noncolin) THEN IF (noncolin) THEN
ijs = 0 ijs = 0
DO is = 1, npol DO is = 1, npol
@ -155,52 +153,52 @@
deff(ih,jh,na) * becp1(ik)%k(jkb,ibnd) * & deff(ih,jh,na) * becp1(ik)%k(jkb,ibnd) * &
(0.d0,-1.d0) * uact(mu+ipol) * tpiba (0.d0,-1.d0) * uact(mu+ipol) * tpiba
ENDIF ENDIF
IF (okvan) THEN ! IF (okvan) THEN
IF (noncolin) THEN ! IF (noncolin) THEN
ijs = 0 ! ijs = 0
DO is = 1, npol ! DO is = 1, npol
DO js = 1, npol ! DO js = 1, npol
ijs = ijs + 1 ! ijs = ijs + 1
ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & ! ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + &
int1_nc(ih,jh,ipol,na,ijs) * & ! int1_nc(ih,jh,ipol,na,ijs) * &
becp1(ik)%nc(jkb,js,ibnd) * uact(mu+ipol) ! becp1(ik)%nc(jkb,js,ibnd) * uact(mu+ipol)
ENDDO ! ENDDO
ENDDO ! ENDDO
ELSE ! ELSE
ps1(ikb,ibnd) = ps1(ikb, ibnd) + & ! ps1(ikb,ibnd) = ps1(ikb, ibnd) + &
int1(ih,jh,ipol,na,current_spin) * & ! int1(ih,jh,ipol,na,current_spin) * &
becp1(ik)%k(jkb,ibnd) * uact(mu +ipol) ! becp1(ik)%k(jkb,ibnd) * uact(mu+ipol)
ENDIF ! ENDIF
ENDIF ! ENDIF ! okvan
ENDIF ! uact>0 ENDIF ! uact>0
IF (okvan) THEN ! IF (okvan) THEN
DO nb = 1, nat ! DO nb = 1, nat
nu = 3 * (nb - 1) ! nu = 3 * (nb - 1)
IF (noncolin) THEN ! IF (noncolin) THEN
IF (lspinorb) THEN ! IF (lspinorb) THEN
ijs = 0 ! ijs = 0
DO is = 1, npol ! DO is = 1, npol
DO js = 1, npol ! DO js = 1, npol
ijs = ijs + 1 ! ijs = ijs + 1
ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & ! ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + &
int2_so(ih,jh,ipol,nb,na,ijs) * & ! int2_so(ih,jh,ipol,nb,na,ijs) * &
becp1(ik)%nc(jkb,js,ibnd) * uact(nu+ipol) ! becp1(ik)%nc(jkb,js,ibnd) * uact(nu+ipol)
ENDDO ! ENDDO
ENDDO ! ENDDO
ELSE ! ELSE
DO is = 1, npol ! DO is = 1, npol
ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + & ! ps1_nc(ikb,is,ibnd) = ps1_nc(ikb,is,ibnd) + &
int2(ih,jh,ipol,nb,na) * & ! int2(ih,jh,ipol,nb,na) * &
becp1(ik)%nc(jkb,is,ibnd) * uact(nu+ipol) ! becp1(ik)%nc(jkb,is,ibnd) * uact(nu+ipol)
ENDDO ! ENDDO
ENDIF ! ENDIF
ELSE ! ELSE
ps1(ikb,ibnd) = ps1(ikb,ibnd) + & ! ps1(ikb,ibnd) = ps1(ikb,ibnd) + &
int2(ih,jh,ipol,nb,na) * & ! int2(ih,jh,ipol,nb,na) * &
becp1(ik)%k(jkb,ibnd) * uact(nu+ipol) ! becp1(ik)%k(jkb,ibnd) * uact(nu+ipol)
ENDIF ! ENDIF
ENDDO ! ENDDO
ENDIF ! okvan ! ENDIF ! okvan
ENDDO ! ipol ENDDO ! ipol
ENDDO ! jh ENDDO ! jh
ENDDO ! ih ENDDO ! ih
@ -241,7 +239,7 @@
DO ig = 1, npwq DO ig = 1, npwq
igg = igkq(ig) igg = igkq(ig)
!aux(ig) = vkb(ig,ikb) * ( xk(ipol,ikq) + g(ipol,igg) ) !aux(ig) = vkb(ig,ikb) * ( xk(ipol,ikq) + g(ipol,igg) )
aux(ig) = vkb(ig,ikb) * ( xxk(ipol) + g(ipol,igg) ) aux(ig) = vkb(ig,ikb) * ( xxkq(ipol) + g(ipol,igg) )
ENDDO ENDDO
DO ibnd = lower_band, upper_band DO ibnd = lower_band, upper_band
IF (noncolin) THEN IF (noncolin) THEN

63
EPW/src/elphel2_shuffle.f90
View File

@ -154,23 +154,23 @@
!! Absolute index of k+q-point !! Absolute index of k+q-point
! !
! Local variables for rotating the wavefunctions (in order to use q in the irr wedge) ! Local variables for rotating the wavefunctions (in order to use q in the irr wedge)
REAL(DP) :: xktmp(3) REAL(kind=DP) :: xkqtmp(3)
!! Temporary k+q vector for KB projectors !! Temporary k+q vector for KB projectors
REAL(DP) :: sxk(3) REAL(kind=DP) :: sxk(3)
!! !! Rotated k-point xk
REAL(DP) :: g0vec_all_r(3,125) REAL(kind=DP) :: g0vec_all_r(3,125)
!! G_0 vectors needed to fold the k+q grid into the k grid, cartesian coord. !! G_0 vectors needed to fold the k+q grid into the k grid, cartesian coord.
REAL(DP) :: zero_vect(3) REAL(kind=DP) :: zero_vect(3)
!! Temporary zero vector !! Temporary zero vector
! !
COMPLEX(DP), ALLOCATABLE :: aux1(:,:), aux2(:,:), aux3(:,:) COMPLEX(kind=DP), ALLOCATABLE :: aux1(:,:), aux2(:,:), aux3(:,:)
COMPLEX(DP), ALLOCATABLE :: eptmp(:,:), elphmat(:,:,:) COMPLEX(kind=DP), ALLOCATABLE :: eptmp(:,:), elphmat(:,:,:)
!! arrays for e-ph matrix elements !! arrays for e-ph matrix elements
! !
!DBSP - NAG complains ... !DBSP - NAG complains ...
COMPLEX(DP), EXTERNAL :: ZDOTC COMPLEX(kind=DP), EXTERNAL :: zdotc
!DBSP !DBSP
! REAL(kind=DP) :: b,c ! REAL(kind=DP) :: b, c, d
!END !END
! !
IF ( .not. ALLOCATED(elphmat) ) ALLOCATE( elphmat(nbnd, nbnd, npe) ) IF ( .not. ALLOCATED(elphmat) ) ALLOCATE( elphmat(nbnd, nbnd, npe) )
@ -221,8 +221,9 @@
IF (lsda) current_spin = isk(ik) IF (lsda) current_spin = isk(ik)
elphmat(:,:,:) = czero elphmat(:,:,:) = czero
!DBSP !DBSP
! c = 0 ! b = zero
! b = 0 ! c = zero
! d = zero
!END !END
! !
! find index, and possibly pool, of k+q ! find index, and possibly pool, of k+q
@ -285,7 +286,7 @@
umatq(:,:,ik) = umat_all(:,:,nkq_abs) umatq(:,:,ik) = umat_all(:,:,nkq_abs)
! !
! the k-vector needed for the KB projectors ! the k-vector needed for the KB projectors
xktmp = xkq(:,ik) xkqtmp = xkq(:,ik)
! !
! -------------------------------------------------- ! --------------------------------------------------
! Fourier translation of the G-sphere igkq ! Fourier translation of the G-sphere igkq
@ -306,7 +307,7 @@
! (this is needed in the calculation of the KB terms ! (this is needed in the calculation of the KB terms
! for nonlocal pseudos) ! for nonlocal pseudos)
! !
xktmp = xkq(:,ik) - g0vec_all_r(:,shift(ik+ik0)) xkqtmp = xkq(:,ik) - g0vec_all_r(:,shift(ik+ik0))
! !
! --------------------------------------------------------------------- ! ---------------------------------------------------------------------
! phase factor arising from fractional traslations ! phase factor arising from fractional traslations
@ -371,8 +372,8 @@
! now we generate vkb on the igkq() set because dvpsi is needed on that set ! now we generate vkb on the igkq() set because dvpsi is needed on that set
! we need S(k)+q_0 in the KB projector: total momentum transfer must be q_0 ! we need S(k)+q_0 in the KB projector: total momentum transfer must be q_0
! !
xktmp = sxk + xq0 xkqtmp = sxk + xq0
CALL init_us_2( npwq, igkq, xktmp, vkb ) CALL init_us_2( npwq, igkq, xkqtmp, vkb )
! !
! -------------------------------------------------- ! --------------------------------------------------
! Calculation of the matrix element ! Calculation of the matrix element
@ -382,15 +383,15 @@
! !
! recalculate dvbare_q*psi_k ! recalculate dvbare_q*psi_k
! the call to dvqpsi_us3 differs from the old one to dvqpsi_us ! the call to dvqpsi_us3 differs from the old one to dvqpsi_us
! only the xktmp passed. ! only the xkqtmp passed.
! !
! we have to use the first q in the star in the dvqpsi_us3 call below (xq0) ! we have to use the first q in the star in the dvqpsi_us3 call below (xq0)
! !
mode = imode0 + ipert mode = imode0 + ipert
IF (timerev) THEN IF (timerev) THEN
CALL dvqpsi_us3( ik, CONJG(u(:,mode)), .false., xktmp, xq0 ) CALL dvqpsi_us3( ik, conjg(u(:,mode)), .false., xkqtmp, xq0 )
ELSE ELSE
CALL dvqpsi_us3( ik, u(:,mode), .false., xktmp, xq0 ) CALL dvqpsi_us3( ik, u(:,mode), .false., xkqtmp, xq0 )
ENDIF ENDIF
!DBSP !DBSP
! b = b+SUM((REAL(REAL(dvpsi(:,:))))**2)+SUM((REAL(AIMAG(dvpsi(:,:))))**2) ! b = b+SUM((REAL(REAL(dvpsi(:,:))))**2)+SUM((REAL(AIMAG(dvpsi(:,:))))**2)
@ -404,7 +405,7 @@
DO ibnd = lower_band, upper_band DO ibnd = lower_band, upper_band
CALL invfft_wave(npw, igk, evc(:,ibnd), aux1) CALL invfft_wave(npw, igk, evc(:,ibnd), aux1)
IF (timerev) THEN IF (timerev) THEN
CALL apply_dpot(dffts%nnr, aux1, CONJG(dvscfins(:,:,ipert)), current_spin) CALL apply_dpot(dffts%nnr, aux1, conjg(dvscfins(:,:,ipert)), current_spin)
ELSE ELSE
CALL apply_dpot(dffts%nnr, aux1, dvscfins(:,:,ipert), current_spin) CALL apply_dpot(dffts%nnr, aux1, dvscfins(:,:,ipert), current_spin)
ENDIF ENDIF
@ -412,10 +413,13 @@
ENDDO ENDDO
dvpsi = dvpsi + aux3 dvpsi = dvpsi + aux3
! !
CALL adddvscf2( ipert, ik )
!
!DBSP !DBSP
! c = c+SUM((REAL(REAL(dvpsi(:,:))))**2)+SUM((REAL(AIMAG(dvpsi(:,:))))**2) ! c = c+SUM((REAL(REAL(dvpsi(:,:))))**2)+SUM((REAL(AIMAG(dvpsi(:,:))))**2)
!END
!
CALL adddvscf2( ipert, ik )
!DBRM
! d = c+SUM((REAL(REAL(dvpsi(:,:))))**2)+SUM((REAL(AIMAG(dvpsi(:,:))))**2)
!END !END
! !
! calculate elphmat(j,i)=<psi_{k+q,j}|dvscf_q*psi_{k,i}> for this pertur ! calculate elphmat(j,i)=<psi_{k+q,j}|dvscf_q*psi_{k,i}> for this pertur
@ -424,10 +428,10 @@
DO ibnd =lower_band, upper_band DO ibnd =lower_band, upper_band
DO jbnd = 1, nbnd DO jbnd = 1, nbnd
elphmat(jbnd,ibnd,ipert) = & elphmat(jbnd,ibnd,ipert) = &
ZDOTC( npwq, evq(1,jbnd), 1, dvpsi(1,ibnd), 1 ) zdotc( npwq, evq(1,jbnd), 1, dvpsi(1,ibnd), 1 )
IF (noncolin) & IF (noncolin) &
elphmat(jbnd,ibnd,ipert) = elphmat(jbnd,ibnd,ipert) + & elphmat(jbnd,ibnd,ipert) = elphmat(jbnd,ibnd,ipert) + &
ZDOTC( npwq, evq(npwx+1,jbnd), 1, dvpsi(npwx+1,ibnd), 1 ) zdotc( npwq, evq(npwx+1,jbnd), 1, dvpsi(npwx+1,ibnd), 1 )
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
@ -439,6 +443,7 @@
! IF (ik==2) THEN ! IF (ik==2) THEN
! write(*,*)'SUM dvpsi b ', b ! write(*,*)'SUM dvpsi b ', b
! write(*,*)'SUM dvpsi c ', c ! write(*,*)'SUM dvpsi c ', c
! write(*,*)'SUM dvpsi d ', d
! write(*,*)'elphmat(:,:,:)**2', SUM((REAL(REAL(elphmat(:,:,:))))**2)+SUM((REAL(AIMAG(elphmat(:,:,:))))**2) ! write(*,*)'elphmat(:,:,:)**2', SUM((REAL(REAL(elphmat(:,:,:))))**2)+SUM((REAL(AIMAG(elphmat(:,:,:))))**2)
! ENDIF ! ENDIF
!END !END
@ -498,8 +503,8 @@
IMPLICIT NONE IMPLICIT NONE
! !
INTEGER, INTENT(in) :: npw, igk(npwx) INTEGER, INTENT(in) :: npw, igk(npwx)
COMPLEX(DP), INTENT(inout) :: evc(npwx*npol, nbnd) COMPLEX(kind=DP), INTENT(inout) :: evc(npwx*npol, nbnd)
COMPLEX(DP), INTENT(in) :: eigv1(ngm), eig0v COMPLEX(kind=DP), INTENT(in) :: eigv1(ngm), eig0v
! !
INTEGER :: ig INTEGER :: ig
!! Counter on G-vectors !! Counter on G-vectors
@ -529,11 +534,15 @@
! !
IMPLICIT NONE IMPLICIT NONE
! !
REAL(kind=DP), INTENT(in) :: x(3)
!! Input x
INTEGER, INTENT(in) :: s(3,3) INTEGER, INTENT(in) :: s(3,3)
REAL(DP), INTENT(in) :: x(3) !! Symmetry matrix
REAL(DP), INTENT(out) :: sx(3) REAL(kind=DP), INTENT(out) :: sx(3)
!! Output rotated x
! !
REAL(DP) :: xcrys(3) REAL(DP) :: xcrys(3)
!! x in cartesian coords
INTEGER :: i INTEGER :: i
! !
xcrys = x xcrys = x

49
EPW/src/elphon_shuffle.f90
View File

@ -13,8 +13,6 @@
!! Electron-phonon calculation from data saved in fildvscf !! Electron-phonon calculation from data saved in fildvscf
!! Shuffle2 mode (shuffle on electrons + load all phonon q's) !! Shuffle2 mode (shuffle on electrons + load all phonon q's)
!! !!
!! No ultrasoft yet
!!
!! RM - Nov/Dec 2014 !! RM - Nov/Dec 2014
!! Imported the noncolinear case implemented by xlzhang !! Imported the noncolinear case implemented by xlzhang
!! !!
@ -24,9 +22,7 @@
! !
USE kinds, ONLY : DP USE kinds, ONLY : DP
USE mp, ONLY : mp_barrier, mp_sum USE mp, ONLY : mp_barrier, mp_sum
USE mp_global, ONLY : my_pool_id, nproc_pool, npool, kunit, & USE mp_global, ONLY : my_pool_id, npool, inter_pool_comm
inter_pool_comm
USE mp_images, ONLY : nproc_image
USE ions_base, ONLY : nat USE ions_base, ONLY : nat
USE pwcom, ONLY : nbnd, nks, nkstot USE pwcom, ONLY : nbnd, nks, nkstot
USE gvect, ONLY : ngm USE gvect, ONLY : ngm
@ -79,47 +75,14 @@
!! Counter on bands !! Counter on bands
INTEGER :: jbnd INTEGER :: jbnd
!! Counter on bands !! Counter on bands
INTEGER :: tmp_pool_id
!! temporary pool id
INTEGER :: iks
!! Index of the first k-point block in this pool
INTEGER :: ik0
!! Index of iks - 1
INTEGER :: nkl
!!
INTEGER :: nkr
!!
! !
COMPLEX(DP), POINTER :: dvscfin(:,:,:) COMPLEX(kind=DP), POINTER :: dvscfin(:,:,:)
!! Change of the scf potential !! Change of the scf potential
COMPLEX(DP), POINTER :: dvscfins(:,:,:) COMPLEX(kind=DP), POINTER :: dvscfins(:,:,:)
!! Change of the scf potential (smooth) !! Change of the scf potential (smooth)
! !
CALL start_clock('elphon_shuffle') CALL start_clock('elphon_shuffle')
! !
ik0 = 0
tmp_pool_id = 0
!
npool = nproc_image / nproc_pool
IF (npool.gt.1) THEN
!
! number of kpoint blocks, kpoints per pool and reminder
kunit = 1
nkl = kunit * ( nkstot / npool )
nkr = ( nkstot - nkl * npool ) / kunit
! the reminder goes to the first nkr pools
IF ( my_pool_id < nkr ) nkl = nkl + kunit
!
iks = nkl * my_pool_id + 1
IF ( my_pool_id >= nkr ) iks = iks + nkr * kunit
!
! the index of the first k point block in this pool - 1
! (I will need the index of ik, not ikk)
!
ik0 = ( iks - 1 ) / kunit
!
ENDIF
!
! read Delta Vscf and calculate electron-phonon coefficients ! read Delta Vscf and calculate electron-phonon coefficients
! !
imode0 = 0 imode0 = 0
@ -152,7 +115,7 @@
dvscfins => dvscfin dvscfins => dvscfin
ENDIF ENDIF
! !
CALL newdq2( dvscfin, npe ) CALL newdq2( dvscfin, npe, xq0, timerev )
CALL elphel2_shuffle( npe, imode0, dvscfins, gmapsym, eigv, isym, xq0, timerev ) CALL elphel2_shuffle( npe, imode0, dvscfins, gmapsym, eigv, isym, xq0, timerev )
! !
imode0 = imode0 + npe imode0 = imode0 + npe
@ -170,8 +133,8 @@
! must be transformed in the cartesian basis ! must be transformed in the cartesian basis
! epmat_{CART} = conjg ( U ) * epmat_{PATTERN} ! epmat_{CART} = conjg ( U ) * epmat_{PATTERN}
! !
! note it is not U^\dagger ! Have a look to symdyn_munu.f90 ! note it is not U^\dagger but u_pattern!
! for comparison ! Have a look to symdyn_munu.f90 for comparison
! !
DO ibnd = 1, nbnd DO ibnd = 1, nbnd
DO jbnd = 1, nbnd DO jbnd = 1, nbnd

39
EPW/src/elphon_shuffle_wrap.f90
View File

@ -455,9 +455,6 @@
! !
minus_q = (iswitch .gt. -3) minus_q = (iswitch .gt. -3)
! !
! ! Initialize vlocq for the current irreducible q-point
! CALL epw_init(.false.)
!
! loop over the q points of the star ! loop over the q points of the star
! !
DO iq = 1, nq DO iq = 1, nq
@ -655,15 +652,14 @@
! !
CALL createkmap( xq ) CALL createkmap( xq )
! !
xq0 = -xq0
!
CALL loadumat( nbnd, nbndsub, nks, nkstot, xq, cu, cuq, lwin, lwinq, exband, w_centers ) CALL loadumat( nbnd, nbndsub, nks, nkstot, xq, cu, cuq, lwin, lwinq, exband, w_centers )
! !
! Calculate overlap U_k+q U_k^\dagger ! Calculate overlap U_k+q U_k^\dagger
IF (lpolar) CALL compute_umn_c( nbnd, nbndsub, nks, cu, cuq, bmat(:,:,:,nqc) ) IF (lpolar) CALL compute_umn_c( nbnd, nbndsub, nks, cu, cuq, bmat(:,:,:,nqc) )
! !
CALL elphon_shuffle( iq_irr, nqc_irr, nqc, gmapsym, eigv, isym, xq0, .true. ) xq0 = -xq0
! !
CALL elphon_shuffle( iq_irr, nqc_irr, nqc, gmapsym, eigv, isym, xq0, .true. )
! bring epmatq in the mode representation of iq_first, ! bring epmatq in the mode representation of iq_first,
! and then in the cartesian representation of iq ! and then in the cartesian representation of iq
! !
@ -795,12 +791,12 @@
! !
IMPLICIT NONE IMPLICIT NONE
! !
REAL(DP), INTENT(in):: x(3) REAL(kind=DP), INTENT(in) :: x(3)
!! Input x !! Input x
INTEGER, INTENT(in) :: s(3,3) INTEGER, INTENT(in) :: s(3,3)
!! Symmetry matrix !! Symmetry matrix
REAL(DP), INTENT(out):: sx(3) REAL(kind=DP), INTENT(out) :: sx(3)
!! Output rotated one. !! Output rotated x
! !
! Local Variable ! Local Variable
INTEGER :: i INTEGER :: i
@ -824,12 +820,12 @@
! !
IMPLICIT NONE IMPLICIT NONE
! !
REAL(DP), INTENT(in) :: x(3) REAL(kind=DP), INTENT(in) :: x(3)
!! input: input vector !! input: input vector
REAL(DP), INTENT(in) :: y(3) REAL(kind=DP), INTENT(in) :: y(3)
!! input: second input vector !! input: second input vector
REAL(DP) :: accep REAL(kind=DP) :: accep
!! acceptance PARAMETER !! acceptance parameter
PARAMETER (accep = 1.0d-5) PARAMETER (accep = 1.0d-5)
! !
eqvect_strict = abs( x(1)-y(1) ) .lt. accep .AND. & eqvect_strict = abs( x(1)-y(1) ) .lt. accep .AND. &
@ -853,13 +849,22 @@
! !
IMPLICIT NONE IMPLICIT NONE
! !
INTEGER, INTENT(IN) :: current_iq INTEGER, INTENT(in) :: current_iq
!! Current q-point !! Current q-point
INTEGER, INTENT(IN) :: iunpun INTEGER, INTENT(in) :: iunpun
!! Current q-point !! Current q-point
INTEGER, INTENT(OUT) :: ierr INTEGER, INTENT(out) :: ierr
!! Error !! Error
INTEGER :: imode0, imode, irr, ipert, iq !
! Local variables
INTEGER :: imode0, imode
!! Counter on modes
INTEGER :: irr
!! Counter on irreducible representations
INTEGER :: ipert
!! Counter on perturbations at each irr
INTEGER :: iq
!! Current q-point
! !
ierr = 0 ierr = 0
IF (meta_ionode) THEN IF (meta_ionode) THEN

58
EPW/src/newdq2.f90
View File

@ -11,7 +11,7 @@
! Adapted from LR_Modules/newdq.f90 (QE) ! Adapted from LR_Modules/newdq.f90 (QE)
! !
!---------------------------------------------------------------------- !----------------------------------------------------------------------
SUBROUTINE newdq2( dvscf, npe ) SUBROUTINE newdq2( dvscf, npe, xq0, timerev )
!---------------------------------------------------------------------- !----------------------------------------------------------------------
!! !!
!! This routine computes the contribution of the selfconsistent !! This routine computes the contribution of the selfconsistent
@ -32,15 +32,19 @@
USE mp_global, ONLY : intra_pool_comm USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum USE mp, ONLY : mp_sum
USE lrus, ONLY : int3 USE lrus, ONLY : int3
USE qpoint, ONLY : xq, eigqts USE qpoint, ONLY : eigqts
USE constants_epw, ONLY : czero USE constants_epw, ONLY : czero
! !
IMPLICIT NONE IMPLICIT NONE
! !
INTEGER, INTENT(in) :: npe INTEGER, INTENT(in) :: npe
!! Number of perturbations for this irr representation !! Number of perturbations for this irr representation
COMPLEX(DP), INTENT(in) :: dvscf(dfftp%nnr, nspin_mag, npe) REAL(kind=DP), INTENT(in) :: xq0(3)
!! The first q-point in the star (cartesian coords.)
COMPLEX(kind=DP), INTENT(in) :: dvscf(dfftp%nnr, nspin_mag, npe)
!! Change of the selfconsistent potential !! Change of the selfconsistent potential
LOGICAL, INTENT(in) :: timerev
!! true if we are using time reversal
! !
! Local variables ! Local variables
! !
@ -61,16 +65,20 @@
INTEGER :: jh INTEGER :: jh
!! Counter on beta functions !! Counter on beta functions
! !
REAL(DP), ALLOCATABLE :: qmod(:) REAL(kind=DP), ALLOCATABLE :: qmod(:)
!! the modulus of q+G !! the modulus of q+G
REAL(DP), ALLOCATABLE :: qg(:,:) REAL(kind=DP), ALLOCATABLE :: qg(:,:)
!! the values of q+G !! the values of q+G
REAL(DP), ALLOCATABLE :: ylmk0(:,:) REAL(kind=DP), ALLOCATABLE :: ylmk0(:,:)
!! the spherical harmonics !! the spherical harmonics at q+G
! !
COMPLEX(DP), EXTERNAL :: zdotc COMPLEX(kind=DP), EXTERNAL :: zdotc
!! the scalar product function !! the scalar product function
COMPLEX(DP), ALLOCATABLE :: aux1(:), aux2(:,:), veff(:), qgm(:) COMPLEX(kind=DP), ALLOCATABLE :: aux1(:), aux2(:,:)
COMPLEX(kind=DP), ALLOCATABLE :: qgm(:)
!! the augmentation function at G
COMPLEX(kind=DP), ALLOCATABLE :: veff(:)
!! effective potential
! !
IF (.not.okvan) RETURN IF (.not.okvan) RETURN
! !
@ -88,7 +96,7 @@
! !
! first compute the spherical harmonics ! first compute the spherical harmonics
! !
CALL setqmod( ngm, xq, g, qmod, qg ) CALL setqmod( ngm, xq0, g, qmod, qg )
CALL ylmr2( lmaxq * lmaxq, ngm, qg, qmod, ylmk0 ) CALL ylmr2( lmaxq * lmaxq, ngm, qg, qmod, ylmk0 )
DO ig = 1, ngm DO ig = 1, ngm
qmod(ig) = sqrt( qmod(ig) ) qmod(ig) = sqrt( qmod(ig) )
@ -102,7 +110,11 @@
! !
DO is = 1, nspin_mag DO is = 1, nspin_mag
DO ir = 1, dfftp%nnr DO ir = 1, dfftp%nnr
IF (timerev) THEN
veff(ir) = conjg(dvscf(ir,is,ipert))
ELSE
veff(ir) = dvscf(ir,is,ipert) veff(ir) = dvscf(ir,is,ipert)
ENDIF
ENDDO ENDDO
CALL fwfft('Rho', veff, dfftp) CALL fwfft('Rho', veff, dfftp)
DO ig = 1, ngm DO ig = 1, ngm
@ -112,9 +124,11 @@
! !
DO nt = 1, ntyp DO nt = 1, ntyp
IF (upf(nt)%tvanp ) THEN IF (upf(nt)%tvanp ) THEN
!
DO ih = 1, nh(nt) DO ih = 1, nh(nt)
DO jh = ih, nh(nt) DO jh = ih, nh(nt)
CALL qvan2( ngm, ih, jh, nt, qmod, qgm, ylmk0 ) CALL qvan2( ngm, ih, jh, nt, qmod, qgm, ylmk0 )
!
DO na = 1, nat DO na = 1, nat
IF (ityp(na) == nt) THEN IF (ityp(na) == nt) THEN
DO ig = 1, ngm DO ig = 1, ngm
@ -129,8 +143,10 @@
ENDDO ENDDO
ENDIF ENDIF
ENDDO ENDDO
ENDDO !
ENDDO ENDDO ! jh
ENDDO ! ih
!
DO na = 1, nat DO na = 1, nat
IF (ityp(na) == nt) THEN IF (ityp(na) == nt) THEN
! !
@ -143,16 +159,24 @@
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
ENDIF !
ENDDO ENDIF ! ityp
ENDIF ENDDO ! na
ENDDO !
ENDDO ENDIF ! upf
ENDDO ! nt
!
ENDDO ! ipert
! !
CALL mp_sum(int3, intra_pool_comm) CALL mp_sum(int3, intra_pool_comm)
! !
IF (noncolin) CALL set_int3_nc( npe ) IF (noncolin) CALL set_int3_nc( npe )
! !
!DMRM
!write(*,'(a,e20.12)') 'int3 = ', &
!SUM((REAL(REAL(int3(:,:,:,:,:))))**2)+SUM((REAL(AIMAG(int3(:,:,:,:,:))))**2)
!END
!
DEALLOCATE(aux1) DEALLOCATE(aux1)
DEALLOCATE(aux2) DEALLOCATE(aux2)
DEALLOCATE(veff) DEALLOCATE(veff)

4
EPW/src/printing.f90
View File

@ -1520,11 +1520,11 @@
CALL print_clock ('epq_init') CALL print_clock ('epq_init')
WRITE( stdout, * ) WRITE( stdout, * )
CALL print_clock ('epq_init') CALL print_clock ('epq_init')
IF (nlcc_any) call print_clock ('set_drhoc') IF (nlcc_any) CALL print_clock ('set_drhoc')
CALL print_clock ('init_vloc') CALL print_clock ('init_vloc')
CALL print_clock ('init_us_1') CALL print_clock ('init_us_1')
CALL print_clock ('newd') CALL print_clock ('newd')
CALL print_clock ('dvanqq') CALL print_clock ('dvanqq2')
CALL print_clock ('drho') CALL print_clock ('drho')
WRITE( stdout, * ) WRITE( stdout, * )
! !

2
test-suite/extract-epw.x
View File

@ -65,7 +65,7 @@ pi=`grep "Re[Pi]=" $fname | awk '{print $4; print $7; print $10}'`
mobvb=`grep "Mobility VB Fermi level" $fname | awk '{print $5}'` mobvb=`grep "Mobility VB Fermi level" $fname | awk '{print $5}'`
mobcb=`grep "Mobility CB Fermi level" $fname | awk '{print $5}'` mobcb=`grep "Mobility CB Fermi level" $fname | awk '{print $5}'`
density=`grep " x-axis" $fname | awk '{print $1; print $2; print $3}'` density=`grep " x-axis" $fname | awk '{print $1; print $2; print $3}'`
mobx=`grep " x-axis" $fname | awk '{print $4}'` mobx=`grep " x-axis" $fname | awk '{print $5}'`
mobav=`grep " avg" $fname | awk '{print $1}'` mobav=`grep " avg" $fname | awk '{print $1}'`
mobxZ=`grep " x-axis [Z]" $fname | awk '{print $1; print $2; print $3; print $4}'` mobxZ=`grep " x-axis [Z]" $fname | awk '{print $1; print $2; print $3; print $4}'`
indabs=`grep " (cm-1)" $fname | awk '{print $1; print $2; print $3; print $4}'` indabs=`grep " (cm-1)" $fname | awk '{print $1; print $2; print $3; print $4}'`