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

XClib - libxc ext params some reorganization

This commit is contained in:
fabrizio22 2021-10-07 17:44:35 +02:00
parent 0f55b03a05
commit c6b6ea0f90
3 changed files with 69 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
XClib/dft_setting_routines.f90
View File

@ -45,9 +45,6 @@ CONTAINS
USE xclib_utils_and_para,ONLY: nowarning
USE dft_setting_params, ONLY: iexch, icorr, igcx, igcc, imeta, imetac, &
discard_input_dft, is_libxc, dft, scan_exx, notset
#if defined(__LIBXC)
USE dft_setting_params, ONLY: xc_kind_error
#endif
USE qe_dft_list, ONLY: nxc, ncc, ngcx, ngcc, nmeta, get_IDs_from_shortname, &
dft_LDAx_name, dft_LDAc_name, dft_GGAx_name, &
dft_GGAc_name, dft_MGGA_name
@ -65,12 +62,6 @@ CONTAINS
LOGICAL :: check_libxc
CHARACTER(len=1) :: lxc
INTEGER :: ID_vec(6)
#if defined(__LIBXC)
INTEGER :: ii, n_ext_params
INTEGER :: flag_v(16), exp2, ftot, ftotx
TYPE(xc_f03_func_t) :: xc_func03
TYPE(xc_f03_func_info_t) :: xc_info03
#endif
INTEGER :: save_iexch, save_icorr, save_igcx, save_igcc, save_meta, &
save_metac
!
@ -173,56 +164,6 @@ CONTAINS
!
#if defined(__LIBXC)
IF (.NOT. dft_defined) CALL matching_libxc( dftout )
!
!------------------------------------------------------------------
! Checks whether external parameters are required by the libxc
! functionals (if present)
!------------------------------------------------------------------
!
ID_vec(1) = iexch ; ID_vec(2) = icorr
ID_vec(3) = igcx ; ID_vec(4) = igcc
ID_vec(5) = imeta ; ID_vec(6) = imetac
!
n_ext_params = 0
DO ii = 1, 6
IF (is_libxc(ii)) THEN
CALL xc_f03_func_init( xc_func03, id_vec(ii), 1 )
xc_info03 = xc_f03_func_get_info(xc_func03)
n_ext_params = xc_f03_func_info_get_n_ext_params(xc_info03)
ftot = xc_f03_func_info_get_flags(xc_info03)
flag_v(1:16) = 0
exp2 = 16
DO WHILE (ftot > 0)
exp2 = exp2 - 1
ftotx = ftot - 2**exp2
IF (ftotx >= 0) THEN
flag_v(exp2+1) = 1
ftot = ftotx
ENDIF
ENDDO
!
IF ( is_libxc(ii) .AND. .NOT.nowarning ) THEN
IF ( n_ext_params /= 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," depends",&
&/5X," on external parameters: check the user_guide of",&
&/5X," QE if you need to modify them or to check their",&
&/5x," default values.")' ) id_vec(ii)
IF ( flag_v(1) == 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",&
&/5X,"provide Exc.")' ) id_vec(ii)
IF ( flag_v(2) == 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",&
&/5X,"provide Vxc: its correct operation in QE is not ", &
&/5X,"guaranteed.")' ) id_vec(ii)
IF (dftout(1:3) .EQ. 'XC-' .AND. flag_v(3) == 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ", &
&/5X,"provide Vxc derivative: its correct operation in QE is",&
&/5X," not possible when derivative is needed.")' ) id_vec(ii)
ENDIF
CALL xc_f03_func_end( xc_func03 )
ENDIF
ENDDO
!
#endif
!
! Back compatibility - TO BE REMOVED
@ -430,9 +371,6 @@ CONTAINS
xc_info = xc_f03_func_get_info( xc_func )
fkind = xc_f03_func_info_get_kind( xc_info )
family = xc_f03_func_info_get_family( xc_info )
IF ( matches('HYB_', TRIM(name)) ) THEN
exx_fraction = xc_f03_hyb_exx_coef( xc_func )
ENDIF
CALL xc_f03_func_end( xc_func )
!
SELECT CASE( family )
@ -1105,14 +1043,16 @@ CONTAINS
USE dft_setting_params, ONLY: iexch, icorr, igcx, igcc, imeta, imetac, &
is_libxc, libxc_initialized
#if defined(__LIBXC)
USE xclib_utils_and_para,ONLY: nowarning
USE dft_setting_params, ONLY: n_ext_params, xc_func, xc_info, par_list, &
libxc_flags
libxc_flags, n_ext_params, exx_fraction, &
ishybrid
#endif
IMPLICIT NONE
INTEGER, INTENT(IN) :: xclib_nspin
LOGICAL, INTENT(IN) :: domag
!! 1: unpolarized case; 2: polarized
INTEGER :: iid, ip, p0, pn, ips, nspin0, iflag
INTEGER :: iid, ip, p0, pn, ips, nspin0, iflag, family
INTEGER :: id_vec(6), flags_tot
!
#if defined(__LIBXC)
@ -1136,15 +1076,21 @@ CONTAINS
IF (is_libxc(iid)) THEN
CALL xc_f03_func_init( xc_func(iid), id_vec(iid), nspin0 )
xc_info(iid) = xc_f03_func_get_info( xc_func(iid) )
family = xc_f03_func_info_get_family( xc_info(iid) )
!
flags_tot = xc_f03_func_info_get_flags( xc_info(iid) )
DO iflag = 15, 0, -1
libxc_flags(iid,iflag) = 0
IF ( flags_tot-2**iflag<0 ) CYCLE
IF ( flags_tot-2**iflag < 0 ) CYCLE
libxc_flags(iid,iflag) = 1
flags_tot = flags_tot-2**iflag
ENDDO
!
IF ( family==XC_FAMILY_HYB_GGA .OR. family==XC_FAMILY_HYB_MGGA ) THEN
exx_fraction = xc_f03_hyb_exx_coef( xc_func(iid) )
ishybrid = ( exx_fraction /= 0.d0 )
ENDIF
!
n_ext_params(iid) = xc_f03_func_info_get_n_ext_params( xc_info(iid) )
#if (XC_MAJOR_VERSION<=5)
p0 = 0 ; pn = n_ext_params(iid)-1 ; ips = 1
@ -1156,8 +1102,31 @@ CONTAINS
xc_info(iid), ip )
ENDDO
libxc_initialized(iid) = .TRUE.
!
IF ( .NOT. nowarning ) THEN
IF ( n_ext_params(iid) /= 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," depends",&
&/5X," on external parameters: check the user_guide of",&
&/5X," QE if you need to modify them or to check their",&
&/5x," default values.")' ) id_vec(iid)
IF ( libxc_flags(iid,0) == 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",&
&/5X,"provide Exc.")' ) id_vec(iid)
IF ( libxc_flags(iid,1) == 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ",&
&/5X,"provide Vxc: its correct operation in QE is not ", &
&/5X,"guaranteed.")' ) id_vec(iid)
IF ( libxc_flags(iid,2) == 0 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," does not ", &
&/5X,"provide Vxc derivative.")' ) id_vec(iid)
IF ( libxc_flags(iid,15) == 1 ) &
WRITE(stdout,'(/5X,"WARNING: libxc functional with ID ",I4," depends on", &
&/5X," the laplacian of the density, which is currently set",&
&/5X," to zero.")' ) id_vec(iid)
ENDIF
ENDIF
ENDDO
!
#endif
RETURN
END SUBROUTINE xclib_init_libxc

4
XClib/xc_wrapper_mgga.f90
View File

@ -14,7 +14,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
#if defined(__LIBXC)
#include "xc_version.h"
USE xc_f03_lib_m
USE dft_setting_params, ONLY: xc_func, xc_info, libxc_flags
USE dft_setting_params, ONLY: xc_func, libxc_flags
#endif
!
USE kind_l, ONLY: DP
@ -67,7 +67,7 @@ SUBROUTINE xc_metagcx( length, ns, np, rho, grho, tau, ex, ec, v1x, v2x, v3x, v1
REAL(DP), ALLOCATABLE :: vc_rho(:), vc_sigma(:), vc_tau(:)
REAL(DP), ALLOCATABLE :: lapl_rho(:), vlapl_rho(:) ! not used in QE
!
INTEGER :: k, ipol, pol_unpol, eflag
INTEGER :: k, ipol, pol_unpol
LOGICAL :: POLARIZED
REAL(DP) :: rh, ggrho2, atau
#if (XC_MAJOR_VERSION > 4)

37
XClib/xclib_test.f90
View File

@ -161,7 +161,7 @@ PROGRAM xclib_test
dvss_aver(1,3)
! ... MGGA aver
REAL(DP) :: v3x_aver(1,2), v3c_aver(1,2)
REAL(DP) :: aver_sndu, aver_recu, vaver(2)
REAL(DP) :: aver_sndu, aver_recu
!
! ... xml
INTEGER :: tag_err
@ -629,6 +629,7 @@ PROGRAM xclib_test
ALLOCATE( exg1(nnr), ecg1(nnr) )
ALLOCATE( v1x1(nnr,ns), v2x1(nnr,ns) )
ALLOCATE( v1c1(nnr,ns), v2c1(nnr,ns), v2c_ud1(nnr) )
v2c_ud1 = 0.d0
ELSE
ALLOCATE( grh(nnr,3,ns) )
ALLOCATE( dvxcrr1(nnr,ns,ns), dvxcsr1(nnr,ns,ns), &
@ -657,6 +658,7 @@ PROGRAM xclib_test
ALLOCATE( exg2(nnrbt), ecg2(nnrbt) )
ALLOCATE( v1x2(nnrbt,ns), v2x2(nnrbt,ns) )
ALLOCATE( v1c2(nnrbt,ns), v2c2(nnrbt,ns), v2c_ud2(nnrbt) )
v2c_ud1 = 0.d0
ELSE
ALLOCATE( dvxcrr2(nnrbt,ns,ns), dvxcsr2(nnrbt,ns,ns), &
dvxcss2(nnrbt,ns,ns) )
@ -1115,11 +1117,15 @@ PROGRAM xclib_test
IF ( .NOT. xc_derivative ) THEN
ex_is_out = exc_term .AND. is_it_out( diff_thr_e_gga, 1, ex1(ii:ii), ex2(ii:ii) )
ec_is_out = cor_term .AND. is_it_out( diff_thr_e_gga, 1, ec1(ii:ii), ec2(ii:ii) )
v1x_is_out= exc_term .AND. is_it_out( diff_thr_vgga,ns, v1x1(ii,:),v1x2(ii,:) )
v2x_is_out= exc_term .AND. is_it_out( diff_thr_vgga,ns, v2x1(ii,:),v2x2(ii,:) )
v1c_is_out= cor_term .AND. is_it_out( diff_thr_vgga,ns, v1c1(ii,:),v1c2(ii,:) )
v2c_is_out= cor_term .AND. is_it_out( diff_thr_vgga,ns, v2c1(ii,:),v2c2(ii,:), &
v1x_is_out= exc_term .AND. is_it_out( diff_thr_vgga, ns, v1x1(ii,:), v1x2(ii,:) )
v2x_is_out= exc_term .AND. is_it_out( diff_thr_vgga, ns, v2x1(ii,:), v2x2(ii,:) )
v1c_is_out= cor_term .AND. is_it_out( diff_thr_vgga, ns, v1c1(ii,:), v1c2(ii,:) )
IF ( .NOT. POLARIZED ) THEN
v2c_is_out= cor_term .AND. is_it_out( diff_thr_vgga, ns, v2c1(ii,:), v2c2(ii,:) )
ELSE
v2c_is_out= cor_term .AND. is_it_out( diff_thr_vgga, ns, v2c1(ii,:), v2c2(ii,:), &
v2c_ud1(ii), v2c_ud2(ii) )
ENDIF
something_out=ANY((/ex_is_out, ec_is_out, v1x_is_out, v2x_is_out, &
v1c_is_out, v2c_is_out/) )
ELSE
@ -1164,8 +1170,12 @@ PROGRAM xclib_test
IF (exc_term .AND. v1x_is_out) CALL print_diff( 'V1x',v1x1(ii,:), v1x2(ii,:) )
IF (exc_term .AND. v2x_is_out) CALL print_diff( 'V2x',v2x1(ii,:), v2x2(ii,:) )
IF (cor_term .AND. v1c_is_out) CALL print_diff( 'V1c',v1c1(ii,:), v1c2(ii,:) )
IF (cor_term .AND. v2c_is_out) CALL print_diff( 'V2c',v2c1(ii,:), v2c2(ii,:), &
IF ( .NOT. POLARIZED ) THEN
IF (cor_term .AND. v2c_is_out) CALL print_diff( 'V2c',v2c1(ii,:), v2c2(ii,:))
ELSE
IF (cor_term .AND. v2c_is_out) CALL print_diff( 'V2c',v2c1(ii,:), v2c2(ii,:),&
v2c_ud1(ii), v2c_ud2(ii) )
ENDIF
ELSE
!
!WRITE(stdout,*) " "
@ -1697,13 +1707,19 @@ PROGRAM xclib_test
CHARACTER(LEN=*), INTENT(IN) :: status
CHARACTER(LEN=100) :: test_output_gen
CHARACTER(LEN=115) :: test_output_exe
INTEGER :: j, id_term
!
IF (test=='gen-benchmark') THEN
test_output_gen = ''
IF (is==is_min) WRITE(test_output_gen(1:3), '(i3)') id
IF (fam_init=='all_terms') THEN
DO j = 1, 6
IF (id_vec(j)/=0) id_term = id_vec(j)
ENDDO
IF (is==is_min) WRITE(test_output_gen(1:3), '(i3)') id_term
WRITE(test_output_gen(5:8), '(a)') TRIM(family)
WRITE(test_output_gen(10:11),'(a)') TRIM(xc_kind)
ELSE
IF (is==is_min) WRITE(test_output_gen(1:3), '(i3)') id
ENDIF
IF (is==1) WRITE(test_output_gen(13:17), '(a)') 'UNPOL'
IF (is==2) WRITE(test_output_gen(13:15), '(a)') 'POL'
@ -1712,10 +1728,15 @@ PROGRAM xclib_test
WRITE(stdout,*) test_output_gen
ELSEIF (test=='exe-benchmark') THEN
test_output_exe = ''
IF (is==is_min) WRITE(test_output_exe(1:3), '(i3)') id
IF (fam_init=='all_terms') THEN
DO j = 1, 6
IF (id_vec(j)/=0) id_term = id_vec(j)
ENDDO
IF (is==is_min) WRITE(test_output_exe(1:3), '(i3)') id_term
WRITE(test_output_exe(5:8), '(a)') TRIM(family)
WRITE(test_output_exe(10:11),'(a)') TRIM(xc_kind)
ELSE
IF (is==is_min) WRITE(test_output_exe(1:3), '(i3)') id
ENDIF
IF (is==1) WRITE(test_output_exe(13:17), '(a)') 'UNPOL'
IF (is==2) WRITE(test_output_exe(13:15), '(a)') 'POL'