Commit fe77de94 authored by timrov's avatar timrov

Deleting old copies of qdipol_cryst.f90 and adddvepsi_us.f90 in PHonon, and

updating Makefile and make.depend.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12178 c92efa57-630b-4861-b058-cf58834340f0
parent 51c90520
......@@ -34,6 +34,8 @@ compute_vsgga.o \
setup_dmuxc.o \
setup_nbnd_occ.o \
setup_alpha_pv.o \
qdipol_cryst.o \
adddvepsi_us.o \
lrcom.o
TLDEPS=libfft mods
......
adddvepsi_us.o : ../Modules/becmod.o
adddvepsi_us.o : ../Modules/control_flags.o
adddvepsi_us.o : ../Modules/ions_base.o
adddvepsi_us.o : ../Modules/kind.o
adddvepsi_us.o : ../Modules/noncol.o
adddvepsi_us.o : ../Modules/uspp.o
adddvepsi_us.o : ../PW/src/pwcom.o
adddvepsi_us.o : lrcom.o
adddvscf.o : ../Modules/ions_base.o
adddvscf.o : ../Modules/kind.o
adddvscf.o : ../Modules/noncol.o
......@@ -170,6 +178,12 @@ orthogonalize.o : ../Modules/recvec.o
orthogonalize.o : ../Modules/uspp.o
orthogonalize.o : ../PW/src/pwcom.o
orthogonalize.o : lrcom.o
qdipol_cryst.o : ../Modules/cell_base.o
qdipol_cryst.o : ../Modules/ions_base.o
qdipol_cryst.o : ../Modules/kind.o
qdipol_cryst.o : ../Modules/uspp.o
qdipol_cryst.o : ../PW/src/pwcom.o
qdipol_cryst.o : lrcom.o
set_dbecsum_nc.o : ../Modules/ions_base.o
set_dbecsum_nc.o : ../Modules/kind.o
set_dbecsum_nc.o : ../Modules/noncol.o
......
......@@ -14,7 +14,6 @@ add_for_charges.o \
add_zstar_ue.o \
add_zstar_ue_us.o \
addcore.o \
adddvepsi_us.o \
addnlcc.o \
addnlcc_zstar_eu_us.o \
addusddens.o \
......@@ -112,7 +111,6 @@ punch_plot_e.o \
q_points.o \
q_points_wannier.o \
q2qstar_ph.o \
qdipol_cryst.o \
random_matrix.o \
read_wfc_rspace_and_fwfft.o \
rotate_dvscf_star.o \
......
!
! 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,
! or http://www.gnu.org/copyleft/gpl.txt .
!
SUBROUTINE adddvepsi_us(becp1,becp2,ipol,kpoint,dvpsi)
! This subdoutine adds to dvpsi the terms which depend on the augmentation
! charge. It assumes that the variable dpqq, has been set and it is in
! the crystal basis.
! It calculates the last two terms of Eq.10 in JCP 21, 9934 (2004).
! P^+_c is applied in solve_e.
!
USE kinds, only : DP
USE spin_orb, ONLY : lspinorb
USE uspp, ONLY : nkb, vkb, qq, qq_so
USE wvfct, ONLY : npwx, npw, nbnd
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE noncollin_module, ONLY : noncolin, npol
USE uspp_param, only: nh
USE becmod, ONLY : bec_type
USE control_flags, ONLY : gamma_only
USE lrus, ONLY : dpqq, dpqq_so
USE control_lr, ONLY : nbnd_occ
implicit none
integer, intent(in) :: ipol, kpoint
TYPE(bec_type), intent(in) :: becp1
TYPE(bec_type), intent(in) :: becp2
COMPLEX(KIND=DP), INTENT(INOUT) :: dvpsi(npwx*npol,nbnd)
complex(DP), allocatable :: ps(:), ps_nc(:,:)
REAL(KIND=DP), ALLOCATABLE :: ps_r(:)
integer:: ijkb0, nt, na, ih, jh, ikb, jkb, ibnd, is, js, ijs
IF (noncolin) THEN
allocate (ps_nc(nbnd,npol))
ELSEIF (gamma_only) THEN
ALLOCATE (ps_r(nbnd))
ELSE
allocate (ps(nbnd))
END IF
ijkb0 = 0
do nt = 1, ntyp
do na = 1, nat
if (ityp(na).eq.nt) then
do ih = 1, nh (nt)
ikb = ijkb0 + ih
IF (noncolin) THEN
ps_nc = (0.d0,0.d0)
ELSEIF (gamma_only) THEN
ps_r = 0.0_DP
ELSE
ps = (0.d0,0.d0)
END IF
do jh = 1, nh (nt)
jkb = ijkb0 + jh
do ibnd=1, nbnd_occ(kpoint)
IF (noncolin) THEN
IF (lspinorb) THEN
ijs=0
do is=1,npol
do js=1,npol
ijs=ijs+1
ps_nc(ibnd,is)=ps_nc(ibnd,is) + &
qq_so(ih,jh,ijs,nt)* &
(0.d0,1.d0)*becp2%nc(jkb,js,ibnd) &
+ becp1%nc(jkb,js,ibnd)* &
dpqq_so(ih,jh,ijs,ipol,nt)
enddo
enddo
ELSE
DO is=1,npol
ps_nc(ibnd,is)=ps_nc(ibnd,is)+ &
qq(ih,jh,nt)*becp2%nc(jkb,is,ibnd)*(0.d0,1.d0) &
+ dpqq(ih,jh,ipol,nt)* &
becp1%nc(jkb,is,ibnd)
END DO
END IF
ELSEIF (gamma_only) THEN
ps_r(ibnd) = ps_r(ibnd)+qq(ih,jh,nt)*becp2&
&%r(jkb,ibnd) + dpqq(ih,jh,ipol,nt)*&
& becp1%r(jkb,ibnd)
ELSE
ps(ibnd) = ps(ibnd)+qq(ih,jh,nt)*becp2%k(jkb,ibnd) &
*(0.d0,1.d0) + &
dpqq(ih,jh,ipol,nt)* becp1%k(jkb,ibnd)
END IF
enddo
enddo
do ibnd = 1, nbnd_occ (kpoint)
IF (noncolin) THEN
CALL zaxpy(npw,ps_nc(ibnd,1),vkb(1,ikb),1, &
dvpsi(1,ibnd),1)
CALL zaxpy(npw,ps_nc(ibnd,2),vkb(1,ikb),1, &
dvpsi(1+npwx,ibnd),1)
ELSEIF (gamma_only) THEN
CALL zaxpy(npw,CMPLX(ps_r(ibnd),0.0_DP,KIND=DP)&
&,vkb(1,ikb),1,dvpsi(1,ibnd),1)
ELSE
CALL zaxpy(npw,ps(ibnd),vkb(1,ikb),1,dvpsi(1,ibnd),1)
END IF
enddo
enddo
ijkb0=ijkb0+nh(nt)
endif
enddo
enddo
if (jkb.ne.nkb) call errore ('adddvepsi_us', 'unexpected error', 1)
IF (noncolin) THEN
deallocate(ps_nc)
ELSEIF (gamma_only) THEN
DEALLOCATE(ps_r)
ELSE
deallocate(ps)
END IF
RETURN
END SUBROUTINE adddvepsi_us
......@@ -48,14 +48,6 @@ addcore.o : ../../Modules/kind.o
addcore.o : ../../Modules/recvec.o
addcore.o : ../../Modules/uspp.o
addcore.o : phcom.o
adddvepsi_us.o : ../../LR_Modules/lrcom.o
adddvepsi_us.o : ../../Modules/becmod.o
adddvepsi_us.o : ../../Modules/control_flags.o
adddvepsi_us.o : ../../Modules/ions_base.o
adddvepsi_us.o : ../../Modules/kind.o
adddvepsi_us.o : ../../Modules/noncol.o
adddvepsi_us.o : ../../Modules/uspp.o
adddvepsi_us.o : ../../PW/src/pwcom.o
adddvscf.o : ../../LR_Modules/lrcom.o
adddvscf.o : ../../Modules/ions_base.o
adddvscf.o : ../../Modules/kind.o
......@@ -1160,12 +1152,6 @@ q_points_wannier.o : dfile_autoname.o
q_points_wannier.o : dfile_star.o
q_points_wannier.o : elph.o
q_points_wannier.o : phcom.o
qdipol_cryst.o : ../../LR_Modules/lrcom.o
qdipol_cryst.o : ../../Modules/cell_base.o
qdipol_cryst.o : ../../Modules/ions_base.o
qdipol_cryst.o : ../../Modules/kind.o
qdipol_cryst.o : ../../Modules/uspp.o
qdipol_cryst.o : ../../PW/src/pwcom.o
raman.o : ../../LR_Modules/lrcom.o
raman.o : ../../Modules/control_flags.o
raman.o : ../../Modules/kind.o
......
!
! 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,
! or http://www.gnu.org/copyleft/gpl.txt .
!
subroutine qdipol_cryst()
!
! This subroutine puts the dipole of Q on the crystal basis
!
USE kinds, ONLY : DP
USE lsda_mod, ONLY : nspin
USE uspp_param, ONLY : nh
USE spin_orb, ONLY : lspinorb
USE cell_base, ONLY : at
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE lrus, ONLY : dpqq, dpqq_so
IMPLICIT NONE
REAL(DP) :: fact(3)
COMPLEX(DP) :: fact_so(3)
INTEGER :: nt, na, ih, jh, ipol, is
DO nt = 1, ntyp
DO ih = 1, nh (nt)
DO jh = 1, nh (nt)
IF (lspinorb) THEN
DO is=1,nspin
DO ipol=1,3
fact_so(ipol)=at(1,ipol)*dpqq_so(ih,jh,is,1,nt)+ &
at(2,ipol)*dpqq_so(ih,jh,is,2,nt)+ &
at(3,ipol)*dpqq_so(ih,jh,is,3,nt)
ENDDO
dpqq_so(ih,jh,is,:,nt)=fact_so(:)
ENDDO
END IF
DO ipol=1,3
fact(ipol)=at(1,ipol)*dpqq(ih,jh,1,nt)+ &
at(2,ipol)*dpqq(ih,jh,2,nt)+ &
at(3,ipol)*dpqq(ih,jh,3,nt)
ENDDO
dpqq(ih,jh,:,nt)=fact(:)
ENDDO
ENDDO
ENDDO
RETURN
END SUBROUTINE qdipol_cryst
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment