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

Moved a part of the PHonon code (which computes the derivative of the XC potential) 

from the routine PHonon/PH/phq_setup.f90 to a new routine "setup_dmuxc.f90"
in LR_Modules. The reason for this action is that the same duplicated part of the
code was present in TDDFPT. Now both PHonon and TDDFPT use the same routine in
LR_Modules/setup_dmuxc.f90. 


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12167 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
timrov 2016-02-27 16:33:33 +00:00
parent a289e4337e
commit 51c86d33ad
6 changed files with 94 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
LR_Modules/Makefile
View File

@ -31,6 +31,7 @@ smallgq.o \
lr_sm1_psi.o \
setup_dgc.o \
compute_vsgga.o \
setup_dmuxc.o \
lrcom.o
TLDEPS=libfft mods

5
LR_Modules/lrcom.f90
View File

@ -66,10 +66,11 @@ MODULE eqv
! the product of dV psi
! the change of the wavefunctions
REAL (DP), ALLOCATABLE :: dmuxc(:,:,:) ! nrxx, nspin, nspin)
REAL (DP), ALLOCATABLE, TARGET :: vlocq(:,:) ! ngm, ntyp)
! the derivative of the xc potential
REAL (DP), ALLOCATABLE, TARGET :: vlocq(:,:) ! ngm, ntyp)
! the local potential at q+G
REAL (DP), ALLOCATABLE :: eprec(:,:) ! needed for preconditioning
REAL (DP), ALLOCATABLE :: eprec(:,:)
! needed for preconditioning
!
END MODULE eqv
!

67
LR_Modules/setup_dmuxc.f90 Normal file
View File

@ -0,0 +1,67 @@
!
! 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 setup_dmuxc
!-----------------------------------------------------------------------
!
! This subroutine computes dmuxc (derivative of the XC potential)
!
USE kinds, ONLY : DP
USE eqv, ONLY : dmuxc
USE lsda_mod, ONLY : lsda
USE fft_base, ONLY : dfftp
USE scf, ONLY : rho, rho_core
USE noncollin_module, ONLY : noncolin, nspin_mag
USE spin_orb, ONLY : domag
USE funct, ONLY : dmxc, dmxc_spin, dmxc_nc
!
IMPLICIT NONE
!
REAL(DP) :: rhotot, rhoup, rhodw
! total charge
! total up charge
! total down charge
REAL(DP) :: auxdmuxc(4,4)
INTEGER :: ir, is, js
!
CALL start_clock ('setup_dmuxc')
!
dmuxc(:,:,:) = 0.d0
!
IF (lsda) THEN
DO ir = 1, dfftp%nnr
rhoup = rho%of_r (ir, 1) + 0.5d0 * rho_core (ir)
rhodw = rho%of_r (ir, 2) + 0.5d0 * rho_core (ir)
CALL dmxc_spin (rhoup, rhodw, dmuxc(ir,1,1), dmuxc(ir,2,1), &
dmuxc(ir,1,2), dmuxc(ir,2,2) )
ENDDO
ELSE
IF (noncolin.and.domag) THEN
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
CALL dmxc_nc (rhotot, rho%of_r(ir,2), rho%of_r(ir,3), rho%of_r(ir,4), auxdmuxc)
DO is=1,nspin_mag
DO js=1,nspin_mag
dmuxc(ir,is,js)=auxdmuxc(is,js)
ENDDO
ENDDO
ENDDO
ELSE
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
IF (rhotot.GT.1.d-30) dmuxc (ir, 1, 1) = dmxc (rhotot)
IF (rhotot.LT. - 1.d-30) dmuxc (ir, 1, 1) = - dmxc ( - rhotot)
ENDDO
ENDIF
ENDIF
!
CALL stop_clock ('setup_dmuxc')
!
RETURN
!
END SUBROUTINE setup_dmuxc

58
PHonon/PH/phq_setup.f90
View File

@ -14,7 +14,8 @@ subroutine phq_setup
! phonon program:
! 1) computes the total local potential (external+scf) on the smooth
! grid to be used in h_psi and similia
! 2) computes dmuxc 3) with GC if needed
! 2) computes the local magnetization (if necessary)
! 3) computes dmuxc (with GC if needed)
! 4) set the inverse of every matrix invs
! 5) for metals sets the occupied bands
! 6) computes alpha_pv
@ -59,7 +60,7 @@ subroutine phq_setup
neldw, two_fermi_energies, wk, nkstot
USE ktetra, ONLY : ltetra
USE lsda_mod, ONLY : nspin, lsda, starting_magnetization, isk
USE scf, ONLY : v, vrs, vltot, rho, rho_core, kedtau
USE scf, ONLY : v, vrs, vltot, kedtau
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm
USE gvecs, ONLY : doublegrid
@ -69,7 +70,7 @@ subroutine phq_setup
USE uspp, ONLY : nlcc_any
USE spin_orb, ONLY : domag
USE constants, ONLY : degspin, pi
USE noncollin_module, ONLY : noncolin, m_loc, angle1, angle2, ux, nspin_mag
USE noncollin_module, ONLY : noncolin, m_loc, angle1, angle2, ux
USE wvfct, ONLY : nbnd, et
USE nlcc_ph, ONLY : drc
USE control_ph, ONLY : rec_code, lgamma_gamma, search_sym, start_irr, &
@ -89,7 +90,7 @@ subroutine phq_setup
USE ph_restart, ONLY : ph_writefile, ph_readfile
USE control_flags, ONLY : modenum, noinv
USE grid_irr_iq, ONLY : comp_irr_iq
USE funct, ONLY : dmxc, dmxc_spin, dmxc_nc, dft_is_gradient
USE funct, ONLY : dft_is_gradient
USE ramanm, ONLY : lraman, elop, ramtns, eloptns, done_lraman, &
done_elop
@ -100,15 +101,11 @@ subroutine phq_setup
USE lr_symm_base, ONLY : gi, gimq, irotmq, minus_q, invsymq, nsymq, rtau
USE qpoint, ONLY : xq, xk_col
USE eqv, ONLY : dmuxc
USE control_lr, ONLY : alpha_pv, nbnd_occ, lgamma
implicit none
real(DP) :: rhotot, rhoup, rhodw, target, small, fac, xmax, emin, emax
! total charge
! total up charge
! total down charge
real(DP) :: target, small, fac, xmax, emin, emax
! auxiliary variables used
! to set nbnd_occ in the metallic case
! minimum band energy
@ -116,11 +113,10 @@ subroutine phq_setup
real(DP) :: sr_is(3,3,48)
integer :: ir, isym, jsym, irot, ik, ibnd, ipol, &
mu, nu, imode0, irr, ipert, na, it, nt, is, js, nsym_is, last_irr_eff
integer :: isym, jsym, irot, ik, ibnd, ipol, &
mu, nu, imode0, irr, ipert, na, it, nt, nsym_is, last_irr_eff
! counters
real(DP) :: auxdmuxc(4,4)
real(DP), allocatable :: wg_up(:,:), wg_dw(:,:)
logical :: sym (48), magnetic_sym
@ -158,12 +154,12 @@ subroutine phq_setup
ENDIF
!!!!!!!!!!!!!!!!!!!!!!!!END OF ACFDT TEST !!!!!!!!!!!!!!!!
!
! 2) Set non linear core correction stuff
! Set non linear core correction stuff
!
nlcc_any = ANY ( upf(1:ntyp)%nlcc )
if (nlcc_any) allocate (drc( ngm, ntyp))
!
! 3) If necessary calculate the local magnetization. This information is
! 2) If necessary calculate the local magnetization. This information is
! needed in find_sym
!
IF (.not.ALLOCATED(m_loc)) ALLOCATE( m_loc( 3, nat ) )
@ -181,39 +177,13 @@ subroutine phq_setup
if (dft_is_gradient()) call compute_ux(m_loc,ux,nat)
ENDIF
!
! 3) Computes the derivative of the xc potential
! 3) Computes the derivative of the XC potential
!
dmuxc(:,:,:) = 0.d0
if (lsda) then
do ir = 1, dfftp%nnr
rhoup = rho%of_r (ir, 1) + 0.5d0 * rho_core (ir)
rhodw = rho%of_r (ir, 2) + 0.5d0 * rho_core (ir)
call dmxc_spin (rhoup, rhodw, dmuxc(ir,1,1), dmuxc(ir,2,1), &
dmuxc(ir,1,2), dmuxc(ir,2,2) )
enddo
else
IF (noncolin.and.domag) THEN
do ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
call dmxc_nc (rhotot, rho%of_r(ir,2), rho%of_r(ir,3), rho%of_r(ir,4), auxdmuxc)
DO is=1,nspin_mag
DO js=1,nspin_mag
dmuxc(ir,is,js)=auxdmuxc(is,js)
END DO
END DO
enddo
ELSE
do ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
if (rhotot.gt.1.d-30) dmuxc (ir, 1, 1) = dmxc (rhotot)
if (rhotot.lt. - 1.d-30) dmuxc (ir, 1, 1) = - dmxc ( - rhotot)
enddo
END IF
endif
call setup_dmuxc()
!
! 3.1) Setup all gradient correction stuff
! Setup all gradient correction stuff
!
call setup_dgc
call setup_dgc()
!
! 4) Computes the inverse of each matrix of the crystal symmetry group
!

2
TDDFPT/Examples/make.sys
View File

@ -7,7 +7,7 @@
#RUNNER = openmpi-1.4.3/bin/mpirun -np 8
#PWSCF = "../../../bin/pw.x" -ndiag 4
RUNNER =
RUNNER =
PWSCF = "../../../bin/pw.x"
TDDFPT_LANCZOS = "../../../bin/turbo_lanczos.x"
TDDFPT_DAVIDSON = "../../../bin/turbo_davidson.x"

71
TDDFPT/src/lr_dv_setup.f90
View File

@ -10,53 +10,31 @@ SUBROUTINE lr_dv_setup
!-----------------------------------------------------------------------
!
! This subroutine prepares some variables which are needed for derivatives
! 1) Set the nonlinear core correction (nlcc) stuff
! 1) Set the nonlinear core correction
! 2) Computes dmuxc (derivative of the XC potential)
! 3) Gradient correction staff (GGA)
!
! Adapted to TDDFPT by Osman Baris Malcioglu (2009)
! 3) Set gradient correction (GGA) if needed
!
USE kinds, ONLY : DP
USE ions_base, ONLY : ntyp => nsp
USE lsda_mod, ONLY : nspin, lsda
USE scf, ONLY : rho, rho_core
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm
USE uspp_param, ONLY : upf
USE spin_orb, ONLY : domag
USE nlcc_ph, ONLY : drc
USE uspp, ONLY : nlcc_any
USE noncollin_module, ONLY : noncolin, nspin_mag
USE noncollin_module, ONLY : noncolin
USE eqv, ONLY : dmuxc
USE funct, ONLY : dmxc, dmxc_spin, dmxc_nc
USE lr_variables, ONLY : lr_verbosity, lr_exx
USE io_global, ONLY : stdout
USE lr_variables, ONLY : lr_exx
USE funct, ONLY : dft_is_gradient, exx_is_active
USE wavefunctions_module, ONLY : psic
!
IMPLICIT NONE
!
REAL(DP) :: rhotot, rhoup, rhodw
! total charge
! total up charge
! total down charge
REAL(DP) :: auxdmuxc(4,4)
INTEGER :: nt, ir, is, js
! counter on mesh points
!
IF (lr_verbosity > 5) THEN
WRITE(stdout,'("<lr_dv_setup>")')
ENDIF
!
CALL start_clock ('lr_dv_setup')
!
! 1) Set the nonlinear core correction stuff
! 1) Set the nonlinear core correction
!
nlcc_any = ANY ( upf(1:ntyp)%nlcc )
!
IF (nlcc_any) ALLOCATE(drc( ngm, ntyp))
!
! 2) Computes the derivative of the XC potential
! 2) Compute the derivative of the XC potential
!
IF ( ( .not. exx_is_active() ) .AND. lr_exx ) THEN
!
@ -68,42 +46,11 @@ SUBROUTINE lr_dv_setup
!
ELSE
!
dmuxc(:,:,:) = 0.0_DP
!
IF (lsda) THEN
!
DO ir = 1, dfftp%nnr
rhoup = rho%of_r (ir, 1) + 0.5d0 * rho_core (ir)
rhodw = rho%of_r (ir, 2) + 0.5d0 * rho_core (ir)
CALL dmxc_spin (rhoup, rhodw, dmuxc(ir,1,1), dmuxc(ir,2,1), &
dmuxc(ir,1,2), dmuxc(ir,2,2) )
ENDDO
!
ELSE
!
IF (noncolin.and.domag) THEN
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
CALL dmxc_nc (rhotot, rho%of_r(ir,2), rho%of_r(ir,3), rho%of_r(ir,4), auxdmuxc)
DO is=1,nspin_mag
DO js=1,nspin_mag
dmuxc(ir,is,js) = auxdmuxc(is,js)
ENDDO
ENDDO
ENDDO
ELSE
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
IF (rhotot.GT.1.d-30) dmuxc (ir, 1, 1) = dmxc (rhotot)
IF (rhotot.LT. - 1.d-30) dmuxc (ir, 1, 1) = - dmxc ( - rhotot)
ENDDO
ENDIF
!
ENDIF
CALL setup_dmuxc()
!
ENDIF
!
! 3) Setup all gradient correction stuff
! 3) Setup gradient correction
!
IF (dft_is_gradient()) THEN
!
@ -118,8 +65,6 @@ SUBROUTINE lr_dv_setup
!
ENDIF
!
IF (lr_verbosity > 5) WRITE(stdout,'("<end of lr_dv_setup>")')
!
CALL stop_clock ('lr_dv_setup')
!
RETURN