diff --git a/XClib/dft_setting_routines.f90 b/XClib/dft_setting_routines.f90 index 63466644f..dc2c8876d 100644 --- a/XClib/dft_setting_routines.f90 +++ b/XClib/dft_setting_routines.f90 @@ -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. - ENDIF + ! + 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 diff --git a/XClib/xc_wrapper_mgga.f90 b/XClib/xc_wrapper_mgga.f90 index ac3242df1..8986d07a9 100644 --- a/XClib/xc_wrapper_mgga.f90 +++ b/XClib/xc_wrapper_mgga.f90 @@ -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) diff --git a/XClib/xclib_test.f90 b/XClib/xclib_test.f90 index 3c7342474..b2d4980af 100644 --- a/XClib/xclib_test.f90 +++ b/XClib/xclib_test.f90 @@ -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,13 +1117,17 @@ 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,:), & - v2c_ud1(ii), v2c_ud2(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/) ) + v1c_is_out, v2c_is_out/) ) ELSE dvxcrr_is_out = is_dit_out(diff_thr_dv,dvxcrr1(ii,:,:),dvxcrr2(ii,:,:)) dvxcsr_is_out = is_dit_out(diff_thr_dv,dvxcsr1(ii,:,:),dvxcsr2(ii,:,:)) @@ -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,:), & - v2c_ud1(ii), v2c_ud2(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'