mirror of https://gitlab.com/QEF/q-e.git
Obsolete xctest.f90 removed (was breaking cmake as well)
This commit is contained in:
Paolo Giannozzi
parent
b241973314
commit
f8d8dcf2d4
|
|
@ -203,18 +203,6 @@ target_link_libraries(qe_pp_pmw_exe
|
|||
qe_pp
|
||||
qe_upflib)
|
||||
|
||||
###########################################################
|
||||
# xctest.x
|
||||
###########################################################
|
||||
set(src_xctest_x src/xctest.f90)
|
||||
qe_add_executable(qe_pp_xctest_exe ${src_xctest_x})
|
||||
set_target_properties(qe_pp_xctest_exe PROPERTIES OUTPUT_NAME xctest.x)
|
||||
target_link_libraries(qe_pp_xctest_exe
|
||||
PRIVATE
|
||||
qe_modules
|
||||
qe_pp
|
||||
qe_xclib)
|
||||
|
||||
###########################################################
|
||||
# projwfc.x
|
||||
###########################################################
|
||||
|
|
@ -511,7 +499,6 @@ qe_install_targets(
|
|||
qe_pp_plotproj_exe
|
||||
qe_pp_plotrho_exe
|
||||
qe_pp_pmw_exe
|
||||
qe_pp_xctest_exe
|
||||
qe_pp_projwfc_exe
|
||||
qe_pp_pw2wannier90_exe
|
||||
qe_pp_pw2critic_exe
|
||||
|
|
|
|||
|
|
@ -126,11 +126,6 @@ pmw.x : poormanwannier.o libpp.a $(MODULES) $(LIBOBJS)
|
|||
$(LIBOBJS) $(QELIBS)
|
||||
- ( cd ../../bin ; ln -fs ../PP/src/$@ . )
|
||||
|
||||
xctest.x : xctest.o libpp.a $(MODULES) $(LIBOBJS)
|
||||
$(LD) $(LDFLAGS) -o $@ \
|
||||
xctest.o libpp.a $(MODULES) $(LIBOBJS) $(QELIBS)
|
||||
- ( cd ../../bin ; ln -fs ../PP/src/$@ . )
|
||||
|
||||
pp.x : postproc.o libpp.a $(MODULES) $(LIBOBJS)
|
||||
$(LD) $(LDFLAGS) -o $@ \
|
||||
postproc.o libpp.a $(MODULES) \
|
||||
|
|
|
|||
|
|
@ -1,192 +0,0 @@
|
|||
!
|
||||
! Copyright (C) 2005 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 .
|
||||
!
|
||||
PROGRAM xctest
|
||||
USE mp_global, ONLY: mp_startup, mp_global_end
|
||||
USE io_global, ONLY: ionode
|
||||
USE kinds, ONLY: DP
|
||||
USE funct, ONLY: set_dft_from_indices
|
||||
IMPLICIT NONE
|
||||
INTEGER :: nnr = 1000
|
||||
INTEGER :: nspin = 2
|
||||
real(DP), ALLOCATABLE :: rhor( :, : )
|
||||
real(DP), ALLOCATABLE :: grhor( :, :, : )
|
||||
INTEGER :: iexch,icorr,igcx,igcc,inlc
|
||||
INTEGER :: nproc, mpime
|
||||
|
||||
CALL mp_startup( )
|
||||
|
||||
if ( ionode ) then
|
||||
iexch=1
|
||||
icorr=3
|
||||
igcx=1
|
||||
igcc=3
|
||||
inlc=0
|
||||
CALL set_dft_from_indices(iexch,icorr,igcx,igcc,0,inlc)
|
||||
|
||||
OPEN(unit=17,form='unformatted',status='old')
|
||||
READ(17) nnr, nspin
|
||||
ALLOCATE(rhor( nnr, nspin ))
|
||||
ALLOCATE(grhor( nnr, 3, nspin ))
|
||||
READ(17) rhor
|
||||
READ(17) grhor
|
||||
CLOSE(17)
|
||||
|
||||
!CALL test_gcxc( nnr, nspin, rhor, grhor )
|
||||
CALL test_xc( nnr, nspin, rhor, grhor )
|
||||
|
||||
end if
|
||||
CALL mp_global_end()
|
||||
END PROGRAM xctest
|
||||
|
||||
SUBROUTINE test_gcxc( nnr, nspin, rhor, grhor )
|
||||
USE kinds, ONLY: DP
|
||||
USE corr_gga, ONLY:glyp
|
||||
USE exch_gga, ONLY:becke88
|
||||
! use funct, only: gcxc
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(in) :: nnr, nspin
|
||||
real(DP) :: rhor( nnr, nspin )
|
||||
real(DP) :: grhor( nnr, 3, nspin )
|
||||
!
|
||||
real(DP), PARAMETER :: epsr = 1.0d-10, epsg = 1.0d-10
|
||||
real(DP), PARAMETER :: e2 = 1.0d0
|
||||
real(DP) :: grho2( nspin )
|
||||
real(DP) :: arho, segno
|
||||
real(DP) :: sx_w, sc_w, v1x_w, v2x_w, v1c_w, v2c_w
|
||||
real(DP) :: sx, sc, v1x, v2x, v1c, v2c
|
||||
real(DP) :: sx_m, sc_m, v1x_m, v2x_m, v1c_m, v2c_m
|
||||
real(DP) :: sx_d, sc_d, v1x_d, v2x_d, v1c_d, v2c_d
|
||||
INTEGER :: k, is, ipol
|
||||
|
||||
DO k = 1, nnr
|
||||
!
|
||||
!
|
||||
DO is = 1, nspin
|
||||
grho2 (is) = grhor(k, 1, is)**2 + grhor(k, 2, is)**2 + grhor(k, 3, is)**2
|
||||
ENDDO
|
||||
!
|
||||
!
|
||||
IF (nspin == 1) THEN
|
||||
!
|
||||
! This is the spin-unpolarised case
|
||||
!
|
||||
arho = abs (rhor (k, 1) )
|
||||
segno = sign (1.d0, rhor (k, 1) )
|
||||
IF (arho > epsr .and. grho2 (1) > epsg) THEN
|
||||
|
||||
! call gcxc (arho, grho2(1), sx, sc, v1x, v2x, v1c, v2c)
|
||||
|
||||
CALL becke88 (arho, grho2(1), sx, v1x, v2x)
|
||||
CALL wrap_b88 (arho, grho2(1), sx_w, v1x_w, v2x_w) ! DEBUG
|
||||
CALL glyp (arho, grho2(1), sc, v1c, v2c)
|
||||
!CALL wrap_glyp (arho, grho2(1), sc_w, v1c_w, v2c_w) ! DEBUG
|
||||
|
||||
sx_d = (sx_w - sx) / (abs(sx) + abs(sx_w))
|
||||
sc_d = (sc_w - sc) / (abs(sc) + abs(sc_w))
|
||||
v1x_d = (v1x_w - v1x) / (abs(v1x) + abs(v1x_w))
|
||||
v1c_d = (v1c_w - v1c) / (abs(v1c) + abs(v1c_w))
|
||||
v2x_d = (v2x_w - v2x) / (abs(v2x) + abs(v2x_w))
|
||||
v2c_d = (v2c_w - v2c) / (abs(v2c) + abs(v2c_w))
|
||||
|
||||
|
||||
WRITE(18,*) arho,grho2(1), sx_d, sc_d
|
||||
WRITE(19,*) arho,grho2(1), v1x_d, v1c_d
|
||||
WRITE(20,*) arho,grho2(1), v2x_w, v2x, v2x_d
|
||||
WRITE(21,*) arho,grho2(1), v2c_w, v2c, v2c_d
|
||||
|
||||
!
|
||||
! first term of the gradient correction : D(rho*Exc)/D(rho)
|
||||
|
||||
! v (k, 1) = v (k, 1) + e2 * (v1x + v1c)
|
||||
|
||||
! HERE h contains D(rho*Exc)/D(|grad rho|) / |grad rho|
|
||||
!
|
||||
! h (k, 1, 1) = e2 * (v2x + v2c)
|
||||
! etxc = etxc + e2 * (sx + sc) * segno
|
||||
|
||||
ELSE
|
||||
! h (k, 1, 1) = 0.d0
|
||||
sx = 0.0d0
|
||||
sc = 0.0d0
|
||||
ENDIF
|
||||
!
|
||||
ENDIF
|
||||
!
|
||||
ENDDO
|
||||
|
||||
RETURN
|
||||
END SUBROUTINE test_gcxc
|
||||
|
||||
!
|
||||
!
|
||||
!
|
||||
|
||||
SUBROUTINE test_xc( nnr, nspin, rhor, grhor )
|
||||
USE kinds, ONLY: DP
|
||||
USE xc_lib, ONLY: xclib_get_id
|
||||
|
||||
IMPLICIT NONE
|
||||
INTEGER, INTENT(in) :: nnr, nspin
|
||||
real(DP) :: rhor( nnr, nspin )
|
||||
real(DP) :: grhor( nnr, 3, nspin )
|
||||
!
|
||||
real(DP) :: rhon( nnr, nspin )
|
||||
real(DP) :: grhon( nnr, 3, nspin )
|
||||
real(DP) :: exc, excn, rhod, grhod
|
||||
INTEGER :: ir, is, ipol
|
||||
INTEGER iexch,icorr,igcx,igcc
|
||||
|
||||
|
||||
iexch = xclib_get_id('LDA','EXCH')
|
||||
icorr = xclib_get_id('LDA','CORR')
|
||||
igcx = xclib_get_id('GGA','EXCH')
|
||||
igcc = xclib_get_id('GGA','CORR')
|
||||
|
||||
rhon = rhor
|
||||
grhon = grhor
|
||||
!
|
||||
! original CP xc selection
|
||||
!
|
||||
IF (iexch==1.and.icorr==1.and.igcx==0.and.igcc==0) THEN
|
||||
! LDA (Perdew-Zunger)
|
||||
CALL expxc(nnr,nspin,rhor,exc)
|
||||
ELSEIF (iexch==1.and.icorr==4.and.igcx==2.and.igcc==2) THEN
|
||||
! PW91
|
||||
CALL ggapwold(nnr,nspin,grhor,rhor,exc)
|
||||
ELSEIF (iexch==1.and.icorr==3.and.igcx==1.and.igcc==3) THEN
|
||||
! BLYP
|
||||
CALL ggablyp4(nnr,nspin,grhor,rhor,exc)
|
||||
ELSEIF (iexch==1.and.icorr==4.and.igcx==3.and.igcc==4) THEN
|
||||
! PBE
|
||||
CALL ggapbe(nnr,nspin,grhor,rhor,exc)
|
||||
ELSE
|
||||
CALL errore('exc-cor','no such exch-corr',1)
|
||||
ENDIF
|
||||
!
|
||||
! Wrapper to PW xc selection
|
||||
!
|
||||
CALL exch_corr_cp(nnr,nspin,grhon,rhon,excn)
|
||||
!
|
||||
WRITE(6,*) 'EXC = ', exc, excn
|
||||
DO is = 1, nspin
|
||||
DO ir = 1, nnr
|
||||
rhod = abs( rhor( ir, is ) - rhon( ir, is ) ) / ( abs( rhor( ir, is ) ) + abs( rhon( ir, is ) ) )
|
||||
WRITE(18,100) ir,is,rhod
|
||||
ENDDO
|
||||
ENDDO
|
||||
DO is = 1, nspin
|
||||
DO ir = 1, nnr
|
||||
DO ipol = 1, 3
|
||||
grhod = abs( grhor( ir, ipol, is ) - grhon( ir, ipol, is ) ) / &
|
||||
( abs( grhor( ir, ipol, is ) ) + abs( grhon( ir, ipol, is ) ) )
|
||||
WRITE(19,100) ir,is,grhod
|
||||
ENDDO
|
||||
ENDDO
|
||||
ENDDO
|
||||
100 FORMAT( I5, I2, 1X, E15.8, 1X, E15.8 )
|
||||
END SUBROUTINE test_xc
|
||||
Loading…
Reference in New Issue