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

XClib - some fixes on libxc blocks

This commit is contained in:
fabrizio22 2020-10-19 15:00:49 +02:00
parent 509ce8ad64
commit fab84cd0a6
7 changed files with 38 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
XClib/dft_mod.f90
View File

@ -1,6 +1,10 @@
!
MODULE dft_mod
!
#if defined(__LIBXC)
USE xc_f03_lib_m
#endif
!
SAVE
!
PRIVATE
@ -16,6 +20,9 @@ MODULE dft_mod
PUBLIC :: xclib_dft_is, xclib_dft_is_libxc, &
start_exx, stop_exx, dft_has_finite_size_correction, &
exx_is_active, igcc_is_lyp, xclib_reset_dft, dft_force_hybrid
#if defined(__LIBXC)
PUBLIC :: get_libxc_flags_exc
#endif
!
CONTAINS
!-------------------------------------------------------------------
@ -26,10 +33,6 @@ CONTAINS
!
USE dft_par_mod
!
#if defined(__LIBXC)
USE xc_f03_lib_m
#endif
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: dft_
@ -459,10 +462,6 @@ CONTAINS
!! It also makes some compatibility checks.
!
USE dft_par_mod
!
#if defined(__LIBXC)
USE xc_f03_lib_m
#endif
!
IMPLICIT NONE
!
@ -501,7 +500,6 @@ CONTAINS
fkind = xc_f03_func_info_get_kind( xc_info )
family = xc_f03_func_info_get_family( xc_info )
IF ( matches('HYB_', TRIM(name)) ) THEN
lxc_hyb = .TRUE.
exx_fraction = xc_f03_hyb_exx_coef( xc_func )
ENDIF
CALL xc_f03_func_end( xc_func )
@ -936,13 +934,7 @@ CONTAINS
! !
! END SUBROUTINE
FUNCTION xclib_get_id( family, kindf )
!
USE dft_par_mod
@ -1179,16 +1171,13 @@ CONTAINS
volume = -1.d0
IF (is_present) volume = finite_size_cell_volume
END SUBROUTINE xclib_get_finite_size_cell_volume
!
!------------------------------------------------------------------------
#if defined(__LIBXC)
SUBROUTINE get_libxc_flags_exc( xc_info, eflag )
! Checks whether Exc is present or not in the output of a libxc
! functional (e.g. TB09)
IMPLICIT NONE
TYPE(xc_f03_func_info_t) :: xc_info
INTEGER :: ii, flags_tot
INTEGER, INTENT(OUT) :: eflag
@ -1430,23 +1419,6 @@ END FUNCTION matches
RETURN
!
END FUNCTION capital
#if defined(__LIBXC)
SUBROUTINE get_libxc_version
!
IMPLICIT NONE
!
INTERFACE
SUBROUTINE xc_version( major, minor, micro ) bind(c)
USE iso_c_binding
INTEGER(c_int) :: major, minor, micro
END SUBROUTINE xc_version
END INTERFACE
!
CALL xc_version( libxc_major, libxc_minor, libxc_micro )
!
END SUBROUTINE get_libxc_version
#endif
!
!
!
END MODULE dft_mod

2
XClib/xc_lib.f90
View File

@ -34,7 +34,7 @@ MODULE xc_lib
xclib_get_exx_fraction, &
xclib_get_finite_size_cell_volume, &
get_screening_parameter, &
get_gau_parameter
get_gau_parameter
!
PUBLIC :: xclib_dft_is, &
xclib_dft_is_libxc, &

1
XClib/xc_wrapper_d_gga.f90
View File

@ -187,6 +187,7 @@ SUBROUTINE dgcxc( length, sp, r_in, g_in, dvxc_rr, dvxc_sr, dvxc_ss )
dvxc_sr(:,1,1) = e2 * (vsrx(:,1) + vsrc(:,1))
dvxc_ss(:,1,1) = e2 * (vssx(:,1) + vssc(:) )
!
!
ELSEIF ( sp == 2 ) THEN
!
ALLOCATE( vrzc(length,sp) )

5
XClib/xc_wrapper_d_lda_lsda.f90
View File

@ -134,11 +134,11 @@ SUBROUTINE dmxc( length, sr_d, rho_in, dmuxc )
!
ELSEIF ((.NOT.is_libxc(1)) .AND. (.NOT.is_libxc(2)) ) THEN
!
!CALL set_threshold_l( 'lda', small )
rho_threshold_lda = small
!
IF ( sr_d == 1 ) CALL dmxc_lda( length, rho_in(:,1), dmuxc(:,1,1) )
IF ( sr_d == 2 ) CALL dmxc_lsda( length, rho_in, dmuxc )
IF ( sr_d == 4 ) CALL dmxc_nc( length, rho_in(:,1), rho_in(:,2:4), dmuxc )
!
ELSE
!
@ -149,7 +149,6 @@ SUBROUTINE dmxc( length, sr_d, rho_in, dmuxc )
!
#else
!
!CALL set_threshold_l( 'lda', small )
rho_threshold_lda = small
!
SELECT CASE( sr_d )
@ -167,7 +166,7 @@ SUBROUTINE dmxc( length, sr_d, rho_in, dmuxc )
!
CASE DEFAULT
!
CALL xclib_error( 'xc_LDA', 'Wrong ns input', 4 )
CALL xclib_error( 'dmxc', 'Wrong ns input', 4 )
!
END SELECT
!

23
XClib/xc_wrapper_gga.f90
View File

@ -41,9 +41,9 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
REAL(DP), INTENT(OUT) :: v1c(:,:)
!! correlation potential (density part)
REAL(DP), INTENT(OUT) :: v2c(:,:)
!! correlation (gradient part)
!! correlation potential (gradient part)
REAL(DP), INTENT(OUT), OPTIONAL :: v2c_ud(:)
!! correlation
!! correlation potential, cross term
!
! ... local variables
!
@ -76,28 +76,9 @@ SUBROUTINE xc_gcx_( length, ns, rho, grho, ex, ec, v1x, v2x, v1c, v2c, v2c_ud )
REAL(DP), PARAMETER :: small = 1.E-10_DP
!
!
!IF (ns==2 .AND. .NOT. PRESENT(v2c_ud)) CALL xclib_error( 'xc_gga', 'cross &
! &term v2c_ud not found', 1 )
IF (ns==2 .AND. .NOT. PRESENT(v2c_ud)) CALL xclib_infomsg( 'xc_gcx', 'WARNING: cross &
&term v2c_ud not found xc_gcx (gga) call with polarized case' )
!
!----PROVISIONAL ---
!IF ( ANY(.NOT.is_libxc(3:4)) ) THEN
! CALL xclib_set_threshold( 'gga', rho_threshold, grho_threshold )
! exx_started = exx_is_active()
! exx_fraction = get_exx_fraction()
! CALL xclib_get_exx( exx_started )
! CALL xclib_get_exx( exx_fraction )
! IF ( igcx==12 ) THEN
! screening_parameter = get_screening_parameter()
! CALL xclib_get_gau_scr_param( screening_parameter ) !---controlla
! ELSEIF (igcx==20 ) THEN
! gau_parameter = get_gau_parameter()
! CALL xclib_get_gau_scr_param( gau_parameter )
! ENDIF
!ENDIF
!----
!
ex = 0.0_DP ; v1x = 0.0_DP ; v2x = 0.0_DP
ec = 0.0_DP ; v1c = 0.0_DP ; v2c = 0.0_DP
IF ( PRESENT(v2c_ud) ) v2c_ud = 0.0_DP

12
XClib/xc_wrapper_lda_lsda.f90
View File

@ -128,10 +128,9 @@ SUBROUTINE xc( length, sr_d, sv_d, rho_in, ex_out, ec_out, vx_out, vc_out )
SELECT CASE( sr_d )
CASE( 1 )
!
!CALL get_ldaxcparlib( 0.d0, exx_started, exx_fraction )
IF (iexch==8 .OR. icorr==10) THEN
!IF (.NOT. is_there_finite_size_corr) CALL xclib_error( 'XC',& !-----RIMETTI-.....
! 'finite size corrected exchange used w/o initialization', 1 )
IF (.NOT. finite_size_cell_volume_set) CALL xclib_error( 'XC',&
'finite size corrected exchange used w/o initialization', 1 )
ENDIF
CALL xc_lda( length, ABS(rho_in(:,1)), ex_out, ec_out, vx_out(:,1), vc_out(:,1) )
!
@ -190,12 +189,9 @@ SUBROUTINE xc( length, sr_d, sv_d, rho_in, ex_out, ec_out, vx_out, vc_out )
SELECT CASE( sr_d )
CASE( 1 )
!
!CALL get_ldaxcparlib( 0.d0, exx_started, exx_fraction )
IF (iexch==8 .OR. icorr==10) THEN
!CALL get_ldaxcparlib( finite_size_cell_volume )
!
!IF (.NOT. is_there_finite_size_corr) CALL xclib_error( 'XC',&
! 'finite size corrected exchange used w/o initialization', 1 ) !-....RIMETTI......
IF (.NOT. finite_size_cell_volume_set) CALL xclib_error( 'XC',&
'finite size corrected exchange used w/o initialization', 1 )
ENDIF
!
CALL xc_lda( length, ABS(rho_in(:,1)), ex_out, ec_out, vx_out(:,1), vc_out(:,1) )

34
XClib/xc_wrapper_mgga.f90
View File

@ -7,8 +7,8 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
!
#if defined(__LIBXC)
#include "xc_version.h"
!USE funct, ONLY : get_libxc_flags_exc !-----sistema
USE xc_f03_lib_m
USE dft_mod, ONLY: get_libxc_flags_exc
#endif
!
USE kind_l, ONLY: DP
@ -74,8 +74,6 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
ex = 0.0_DP ; v1x = 0.0_DP ; v2x = 0.0_DP ; v3x = 0.0_DP
ec = 0.0_DP ; v1c = 0.0_DP ; v2c = 0.0_DP ; v3c = 0.0_DP
!
CALL set_threshold_l( 'mgga', rho_threshold, grho2_threshold, tau_threshold )
!
POLARIZED = .FALSE.
IF (ns == 2) THEN
POLARIZED = .TRUE.
@ -97,8 +95,8 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
DO k = 1, length
rho_lxc(k) = ABS( rho(k,1) )
sigma(k) = MAX( grho(1,k,1)**2 + grho(2,k,1)**2 + grho(3,k,1)**2, &
grho2_threshold )
tau_lxc(k) = MAX( tau(k,1), tau_threshold )
grho2_threshold_mgga )
tau_lxc(k) = MAX( tau(k,1), tau_threshold_mgga )
ENDDO
!
ELSE
@ -108,14 +106,14 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
rho_lxc(2*k) = ABS( rho(k,2) )
!
sigma(3*k-2) = MAX( grho(1,k,1)**2 + grho(2,k,1)**2 + grho(3,k,1)**2, &
grho2_threshold )
grho2_threshold_mgga )
sigma(3*k-1) = grho(1,k,1) * grho(1,k,2) + grho(2,k,1) * grho(2,k,2) + &
grho(3,k,1) * grho(3,k,2)
sigma(3*k) = MAX( grho(1,k,2)**2 + grho(2,k,2)**2 + grho(3,k,2)**2, &
grho2_threshold )
grho2_threshold_mgga )
!
tau_lxc(2*k-1) = MAX( tau(k,1), tau_threshold )
tau_lxc(2*k) = MAX( tau(k,2), tau_threshold )
tau_lxc(2*k-1) = MAX( tau(k,1), tau_threshold_mgga )
tau_lxc(2*k) = MAX( tau(k,2), tau_threshold_mgga )
ENDDO
!
ENDIF
@ -145,15 +143,15 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
IF ( is_libxc(5) ) THEN
CALL xc_f03_func_init( xc_func, imeta, pol_unpol )
xc_info1 = xc_f03_func_get_info( xc_func )
CALL xc_f03_func_set_dens_threshold( xc_func, rho_threshold )
! CALL get_libxc_flags_exc( xc_info1, eflag ) !----sistema
! IF (eflag==1) THEN
CALL xc_f03_func_set_dens_threshold( xc_func, rho_threshold_mgga )
CALL get_libxc_flags_exc( xc_info1, eflag )
IF (eflag==1) THEN
CALL xc_f03_mgga_exc_vxc( xc_func, lengthxc, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), &
ex_lxc(1), vx_rho(1), vx_sigma(1), vlapl_rho(1), vx_tau(1) )
! ELSE
! CALL xc_f03_mgga_vxc( xc_func, lengthxc, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), & !---sistema
! vx_rho(1), vx_sigma(1), vlapl_rho(1), vx_tau(1) )
! ENDIF
ELSE
CALL xc_f03_mgga_vxc( xc_func, lengthxc, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), &
vx_rho(1), vx_sigma(1), vlapl_rho(1), vx_tau(1) )
ENDIF
CALL xc_f03_func_end( xc_func )
!
IF (.NOT. POLARIZED) THEN
@ -177,7 +175,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
!
! ... only for HK/MCA: SCAN0 (used in CPV)
IF ( scan_exx ) THEN
IF (exx_is_active()) THEN
IF (exx_started) THEN
ex = (1.0_DP - exx_fraction) * ex
v1x = (1.0_DP - exx_fraction) * v1x
v2x = (1.0_DP - exx_fraction) * v2x
@ -193,7 +191,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
!
CALL xc_f03_func_init( xc_func, imetac, pol_unpol )
xc_info1 = xc_f03_func_get_info( xc_func )
CALL xc_f03_func_set_dens_threshold( xc_func, rho_threshold )
CALL xc_f03_func_set_dens_threshold( xc_func, rho_threshold_mgga )
CALL xc_f03_mgga_exc_vxc( xc_func, lengthxc, rho_lxc(1), sigma(1), lapl_rho(1), tau_lxc(1), &
ec_lxc(1), vc_rho(1), vc_sigma(1), vlapl_rho(1), vc_tau(1) )
CALL xc_f03_func_end( xc_func )