TABLE OF CONTENTS
- ABINIT/libxc_functionals
- libxc_functionals/libxc_functionals_check
- libxc_functionals/libxc_functionals_compute_tb09
- libxc_functionals/libxc_functionals_constants_load
- libxc_functionals/libxc_functionals_depends_on_temp
- libxc_functionals/libxc_functionals_end
- libxc_functionals/libxc_functionals_family_from_id
- libxc_functionals/libxc_functionals_fullname
- libxc_functionals/libxc_functionals_get_hybridparams
- libxc_functionals/libxc_functionals_getid
- libxc_functionals/libxc_functionals_getrefs
- libxc_functionals/libxc_functionals_getvxc
- libxc_functionals/libxc_functionals_gga_from_hybrid
- libxc_functionals/libxc_functionals_has_k3xc
- libxc_functionals/libxc_functionals_has_kxc
- libxc_functionals/libxc_functionals_init
- libxc_functionals/libxc_functionals_is_hybrid
- libxc_functionals/libxc_functionals_is_hybrid_from_id
- libxc_functionals/libxc_functionals_is_tb09
- libxc_functionals/libxc_functionals_isgga
- libxc_functionals/libxc_functionals_islda
- libxc_functionals/libxc_functionals_ismgga
- libxc_functionals/libxc_functionals_ixc
- libxc_functionals/libxc_functionals_needs_laplacian
- libxc_functionals/libxc_functionals_needs_temperature
- libxc_functionals/libxc_functionals_nspin
- libxc_functionals/libxc_functionals_set_c_tb09
- libxc_functionals/libxc_functionals_set_hybridparams
- libxc_functionals/libxc_functionals_set_temp
- libxc_functionals/libxc_functionals_set_temperature
- libxc_functionals/xc_char_to_c
- libxc_functionals/xc_char_to_f
ABINIT/libxc_functionals [ Modules ]
NAME
libxc_functionals
FUNCTION
Module containing interfaces to the LibXC library, for exchange correlation potentials and energies. The interfacing between the ABINIT and LibXC formats and datastructures happens here. Also contains basic container datatype for LibXC interfacing.
COPYRIGHT
Copyright (C) 2008-2024 ABINIT group (MOliveira,LHH,FL,GMR,MT) This file is distributed under the terms of the GNU Gener_al Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
NOTES
libxc_functionals.F90 defines a structured datatype (libxc_functional_type) and associated methods to initialize/finalize it and get properties from it. Abinit used a global variable (xc_global, libxc_functional_type) which is initialized in the driving routine (driver) with the value of ixc specified by the user in the input file. * It is possible to change the value of ixc at run-time; for that we have to reinitialize the global structure with the new value of ixc before computing XC quantities. Moreover one has to reinstate the old functional before returning so that the other routines will continue to used the previous ixc. This task can be accomplished with the following pseudocode: !!!!! if (old_ixc<0) call libxc_functionals_end() !!!!! if (new_ixc<0) call libxc_functionals_init(new_ixc,nspden) !!!!! >>>> Compute XC stuff here. !!!!! if (new_ixc<0) call libxc_functionals_end() !!!!! if (old_ixc<0) call libxc_functionals_init(old_ixc,nspden) * It is also possible to define a local (private) variable of type libxc_functional_type. For that, the different methods have to be called with an extra optional argument (called xc_funcs in this example): !!!!! call libxc_functionals_init(ixc,nspden,xc_funcs) !!!!! call libxc_functionals_end(xc_funcs)
SOURCE
41 #if defined HAVE_CONFIG_H 42 #include "config.h" 43 #endif 44 45 #include "abi_common.h" 46 47 module libxc_functionals 48 49 use defs_basis 50 use m_abicore 51 use m_errors 52 53 !ISO C bindings are mandatory 54 #ifdef HAVE_FC_ISO_C_BINDING 55 use, intrinsic :: iso_c_binding 56 #endif 57 58 implicit none 59 private 60 61 !Public functions 62 public :: libxc_functionals_check ! Check if the code has been compiled with libXC 63 public :: libxc_functionals_init ! Initialize a set of XC functional(s), from libXC 64 public :: libxc_functionals_end ! End usage of a set of libXC functional(s) 65 public :: libxc_functionals_fullname ! Return full name of a set of XC functional(s) 66 public :: libxc_functionals_getid ! Return identifer of a XC functional, from its name 67 public :: libxc_functionals_family_from_id ! Retrieve family of a XC functional, from its id 68 public :: libxc_functionals_ixc ! The value of ixc used to initialize the XC functional(s) 69 public :: libxc_functionals_islda ! Return TRUE if the set of XC functional(s) is LDA 70 public :: libxc_functionals_isgga ! Return TRUE if the set of XC functional(s) is GGA or meta-GGA 71 public :: libxc_functionals_ismgga ! Return TRUE if the set of XC functional(s) set is meta-GGA 72 public :: libxc_functionals_is_tb09 ! Return TRUE if the XC functional is Tran-Blaha 2009. 73 public :: libxc_functionals_set_c_tb09 ! Set c parameter for Tran-Blaha 2009 functional 74 public :: libxc_functionals_needs_laplacian ! Return TRUE if the set of XC functional(s) uses LAPLACIAN 75 public :: libxc_functionals_needs_temperature ! Return TRUE if the set of XC functional(s) uses the elec. temperature 76 public :: libxc_functionals_set_temperature ! Set electronic temperature in a set of XC functional(s) 77 public :: libxc_functionals_has_kxc ! Return TRUE if Kxc (3rd der) is available for a set of XC functional(s) set 78 public :: libxc_functionals_has_k3xc ! Return TRUE if K3xc (4th der) is available for a set of XC functional(s) set 79 public :: libxc_functionals_nspin ! The number of spin components for the set of XC functional(s) 80 public :: libxc_functionals_is_hybrid ! Return TRUE if a set of XC functional(s) is hybrid 81 public :: libxc_functionals_is_hybrid_from_id ! Return TRUE if a XC functional is hybrid, from its id 82 public :: libxc_functionals_get_hybridparams ! Retrieve parameter(s) of hybrid functional(s) 83 public :: libxc_functionals_set_hybridparams ! Change parameter(s) of hybrid functional(s) 84 public :: libxc_functionals_gga_from_hybrid ! Return the id of the XC-GGA used for the hybrid 85 public :: libxc_functionals_getvxc ! Return XC potential and energy, from input density 86 87 !Private functions 88 private :: libxc_functionals_compute_tb09 ! Compute c parameter for Tran-Blaha 2009 functional 89 private :: libxc_functionals_getrefs ! Get references of a single XC functional 90 private :: libxc_functionals_depends_on_temp ! TRUE if a single functional depends on elec. temperature 91 private :: libxc_functionals_set_temp ! Set electronic temperature in a single XC functional 92 private :: libxc_functionals_constants_load ! Load libXC constants from C headers 93 #ifdef HAVE_FC_ISO_C_BINDING 94 private :: xc_char_to_c ! Convert a string from Fortran to C 95 private :: xc_char_to_f ! Convert a string from C to Fortran 96 #endif 97 98 !Public constants (use libxc_functionals_constants_load to init them) 99 integer,public,save :: XC_FAMILY_UNKNOWN = -1 100 integer,public,save :: XC_FAMILY_LDA = 1 101 integer,public,save :: XC_FAMILY_GGA = 2 102 integer,public,save :: XC_FAMILY_MGGA = 4 103 integer,public,save :: XC_FAMILY_LCA = 8 104 integer,public,save :: XC_FAMILY_OEP = 16 105 integer,public,save :: XC_FAMILY_HYB_GGA = 32 106 integer,public,save :: XC_FAMILY_HYB_MGGA = 64 107 integer,public,save :: XC_FAMILY_HYB_LDA =128 108 integer,public,save :: XC_FLAGS_HAVE_EXC = 1 109 integer,public,save :: XC_FLAGS_HAVE_VXC = 2 110 integer,public,save :: XC_FLAGS_HAVE_FXC = 4 111 integer,public,save :: XC_FLAGS_HAVE_KXC = 8 112 integer,public,save :: XC_FLAGS_HAVE_LXC = 16 113 integer,public,save :: XC_FLAGS_NEEDS_LAPLACIAN= 32768 114 integer,public,save :: XC_EXCHANGE = 0 115 integer,public,save :: XC_CORRELATION = 1 116 integer,public,save :: XC_EXCHANGE_CORRELATION = 2 117 integer,public,save :: XC_KINETIC = 3 118 integer,public,save :: XC_SINGLE_PRECISION = 0 119 logical,private,save :: libxc_constants_initialized=.false. 120 121 !XC functional public type 122 type,public :: libxc_functional_type 123 integer :: id ! identifier 124 integer :: family ! LDA, GGA, etc. 125 integer :: kind ! EXCHANGE, CORRELATION, etc. 126 integer :: nspin ! # of spin components 127 integer :: abi_ixc ! Abinit IXC id for this functional 128 logical :: has_exc ! TRUE is exc is available for the functional 129 logical :: has_vxc ! TRUE is vxc is available for the functional 130 logical :: has_fxc ! TRUE is fxc is available for the functional 131 logical :: has_kxc ! TRUE is kxc is available for the functional 132 logical :: needs_laplacian ! TRUE is functional needs laplacian of density 133 logical :: is_hybrid ! TRUE is functional is a hybrid functional 134 real(dp) :: hyb_mixing ! Hybrid functional: mixing factor of Fock contribution (default=0) 135 real(dp) :: hyb_mixing_sr ! Hybrid functional: mixing factor of SR Fock contribution (default=0) 136 real(dp) :: hyb_range ! Range (for separation) for a hybrid functional (default=0) 137 real(dp) :: temperature ! Electronic temperature; if <=0, the functional doesnt depend on it 138 real(dp) :: xc_tb09_c ! Special TB09 functional parameter 139 real(dp) :: sigma_threshold ! Value of a threshold to be applied on density gradient (sigma) 140 ! (temporary dur to a libxc bug) - If <0, apply no filter 141 #ifdef HAVE_FC_ISO_C_BINDING 142 type(C_PTR),pointer :: conf => null() ! C pointer to the functional itself 143 #endif 144 end type libxc_functional_type 145 146 !List of functionals on which a filter has to be applied on sigma (density gradient) 147 ! This should be done by libXC via _set_sigma_threshold but this is not (libXC 6) 148 ! This threshold has been evaluated from pbeh functional... 149 real(dp),parameter :: sigma_threshold_def = 1.0e-25_dp 150 integer,parameter :: n_sigma_filtered = 17 151 character(len=28) :: sigma_filtered(n_sigma_filtered) = & 152 & ['XC_HYB_GGA_XC_HSE03 ','XC_HYB_GGA_XC_HSE06 ','XC_HYB_GGA_XC_HJS_PBE ',& 153 & 'XC_HYB_GGA_XC_HJS_PBE_SOL ','XC_HYB_GGA_XC_HJS_B88 ','XC_HYB_GGA_XC_HJS_B97X ',& 154 & 'XC_HYB_GGA_XC_LRC_WPBEH ','XC_HYB_GGA_XC_LRC_WPBE ','XC_HYB_GGA_XC_LC_WPBE ',& 155 & 'XC_HYB_GGA_XC_HSE12 ','XC_HYB_GGA_XC_HSE12S ','XC_HYB_GGA_XC_HSE_SOL ',& 156 & 'XC_HYB_GGA_XC_LC_WPBE_WHS ','XC_HYB_GGA_XC_LC_WPBEH_WHS ','XC_HYB_GGA_XC_LC_WPBE08_WHS ',& 157 & 'XC_HYB_GGA_XC_LC_WPBESOL_WHS','XC_HYB_GGA_XC_WHPBE0 '] 158 159 !---------------------------------------------------------------------- 160 161 !Private global XC functional 162 type(libxc_functional_type),target,save :: xc_global(2) 163 164 !---------------------------------------------------------------------- 165 166 !Interfaces for C bindings 167 #ifdef HAVE_FC_ISO_C_BINDING 168 interface 169 integer(C_INT) function xc_func_init(xc_func,functional,nspin) bind(C) 170 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 171 integer(C_INT),value :: functional,nspin 172 type(C_PTR) :: xc_func 173 end function xc_func_init 174 end interface 175 ! 176 interface 177 subroutine xc_func_end(xc_func) bind(C) 178 use, intrinsic :: iso_c_binding, only : C_PTR 179 type(C_PTR) :: xc_func 180 end subroutine xc_func_end 181 end interface 182 ! 183 interface 184 integer(C_INT) function xc_functional_get_number(name) bind(C) 185 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 186 type(C_PTR),value :: name 187 end function xc_functional_get_number 188 end interface 189 ! 190 interface 191 type(C_PTR) function xc_functional_get_name(number) bind(C) 192 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 193 integer(C_INT),value :: number 194 end function xc_functional_get_name 195 end interface 196 ! 197 interface 198 integer(C_INT) function xc_family_from_id(id,family,number) bind(C) 199 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 200 integer(C_INT),value :: id 201 type(C_PTR),value :: family,number 202 end function xc_family_from_id 203 end interface 204 ! 205 interface 206 subroutine xc_hyb_cam_coef(xc_func,omega,alpha,beta) bind(C) 207 use, intrinsic :: iso_c_binding, only : C_DOUBLE,C_PTR 208 real(C_DOUBLE) :: omega,alpha,beta 209 type(C_PTR) :: xc_func 210 end subroutine xc_hyb_cam_coef 211 end interface 212 ! 213 interface 214 subroutine xc_get_lda(xc_func,np,rho,zk,vrho,v2rho2,v3rho3) bind(C) 215 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 216 integer(C_INT),value :: np 217 type(C_PTR),value :: rho,zk,vrho,v2rho2,v3rho3 218 type(C_PTR) :: xc_func 219 end subroutine xc_get_lda 220 end interface 221 ! 222 interface 223 subroutine xc_get_gga(xc_func,np,rho,sigma,zk,vrho,vsigma,v2rho2,v2rhosigma,v2sigma2, & 224 & v3rho3,v3rho2sigma,v3rhosigma2,v3sigma3) bind(C) 225 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 226 integer(C_INT),value :: np 227 type(C_PTR),value :: rho,sigma,zk,vrho,vsigma,v2rho2,v2rhosigma,v2sigma2, & 228 & v3rho3,v3rho2sigma,v3rhosigma2,v3sigma3 229 type(C_PTR) :: xc_func 230 end subroutine xc_get_gga 231 end interface 232 ! 233 interface 234 subroutine xc_get_mgga(xc_func,np,rho,sigma,lapl,tau,zk,vrho,vsigma,vlapl,vtau, & 235 & v2rho2,v2rhosigma,v2rholapl,v2rhotau,v2sigma2,v2sigmalapl, & 236 & v2sigmatau,v2lapl2,v2lapltau,v2tau2) bind(C) 237 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 238 integer(C_INT),value :: np 239 type(C_PTR),value :: rho,sigma,lapl,tau,zk,vrho,vsigma,vlapl,vtau, & 240 & v2rho2,v2sigma2,v2lapl2,v2tau2,v2rhosigma,v2rholapl,v2rhotau, & 241 & v2sigmalapl,v2sigmatau,v2lapltau 242 type(C_PTR) :: xc_func 243 end subroutine xc_get_mgga 244 end interface 245 ! 246 interface 247 subroutine xc_func_set_params(xc_func,params,n_params) bind(C) 248 use, intrinsic :: iso_c_binding, only : C_INT,C_DOUBLE,C_PTR 249 integer(C_INT),value :: n_params 250 real(C_DOUBLE) :: params(*) 251 type(C_PTR) :: xc_func 252 end subroutine xc_func_set_params 253 end interface 254 ! 255 interface 256 integer(C_INT) function xc_func_set_params_name(xc_func,name,param) bind(C) 257 use, intrinsic :: iso_c_binding, only : C_INT,C_DOUBLE,C_PTR 258 real(C_DOUBLE) :: param 259 type(C_PTR) :: xc_func 260 type(C_PTR),value :: name 261 end function xc_func_set_params_name 262 end interface 263 ! 264 interface 265 type(C_PTR) function xc_func_get_params_name(xc_func,ipar) bind(C) 266 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 267 type(C_PTR) :: xc_func 268 integer(C_INT) :: ipar 269 end function xc_func_get_params_name 270 end interface 271 ! 272 interface 273 type(C_PTR) function xc_func_get_params_description(xc_func,ipar) bind(C) 274 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 275 type(C_PTR) :: xc_func 276 integer(C_INT) :: ipar 277 end function xc_func_get_params_description 278 end interface 279 ! 280 interface 281 subroutine xc_func_set_density_threshold(xc_func,dens_threshold) bind(C) 282 use, intrinsic :: iso_c_binding, only : C_DOUBLE,C_PTR 283 real(C_DOUBLE) :: dens_threshold 284 type(C_PTR) :: xc_func 285 end subroutine xc_func_set_density_threshold 286 end interface 287 ! 288 interface 289 subroutine xc_func_set_sig_threshold(xc_func,sigma_threshold) bind(C) 290 use, intrinsic :: iso_c_binding, only : C_DOUBLE,C_PTR 291 real(C_DOUBLE) :: sigma_threshold 292 type(C_PTR) :: xc_func 293 end subroutine xc_func_set_sig_threshold 294 end interface 295 ! 296 interface 297 integer(C_INT) function xc_func_is_hybrid_from_id(func_id) bind(C) 298 use, intrinsic :: iso_c_binding, only : C_INT 299 integer(C_INT),value :: func_id 300 end function xc_func_is_hybrid_from_id 301 end interface 302 ! 303 interface 304 subroutine xc_get_singleprecision_constant(xc_cst_singleprecision) bind(C) 305 use, intrinsic :: iso_c_binding, only : C_INT 306 integer(C_INT) :: xc_cst_singleprecision 307 end subroutine xc_get_singleprecision_constant 308 end interface 309 ! 310 interface 311 subroutine xc_get_family_constants(xc_cst_unknown,xc_cst_lda,xc_cst_gga,xc_cst_mgga, & 312 & xc_cst_lca,xc_cst_oep,xc_cst_hyb_gga, & 313 & xc_cst_hyb_mgga,xc_cst_hyb_lda) bind(C) 314 use, intrinsic :: iso_c_binding, only : C_INT 315 integer(C_INT) :: xc_cst_unknown,xc_cst_lda,xc_cst_gga,xc_cst_mgga, & 316 & xc_cst_lca,xc_cst_oep,xc_cst_hyb_gga,xc_cst_hyb_mgga, & 317 & xc_cst_hyb_lda 318 end subroutine xc_get_family_constants 319 end interface 320 ! 321 interface 322 subroutine xc_get_flags_constants(xc_cst_flags_have_exc,xc_cst_flags_have_vxc, & 323 xc_cst_flags_have_fxc,xc_cst_flags_have_kxc,xc_cst_flags_have_lxc,& 324 & xc_cxt_flags_needs_lapl) bind(C) 325 use, intrinsic :: iso_c_binding, only : C_INT 326 integer(C_INT) :: xc_cst_flags_have_exc,xc_cst_flags_have_vxc,xc_cst_flags_have_fxc, & 327 & xc_cst_flags_have_kxc,xc_cst_flags_have_lxc,xc_cxt_flags_needs_lapl 328 end subroutine xc_get_flags_constants 329 end interface 330 ! 331 interface 332 subroutine xc_get_kind_constants(xc_cst_exchange,xc_cst_correlation, & 333 & xc_cst_exchange_correlation,xc_cst_kinetic) bind(C) 334 use, intrinsic :: iso_c_binding, only : C_INT 335 integer(C_INT) :: xc_cst_exchange,xc_cst_correlation, & 336 & xc_cst_exchange_correlation,xc_cst_kinetic 337 end subroutine xc_get_kind_constants 338 end interface 339 ! 340 interface 341 type(C_PTR) function xc_func_type_malloc() bind(C) 342 use, intrinsic :: iso_c_binding, only : C_PTR 343 end function xc_func_type_malloc 344 end interface 345 ! 346 interface 347 subroutine xc_func_type_free(xc_func) bind(C) 348 use, intrinsic :: iso_c_binding, only : C_PTR 349 type(C_PTR) :: xc_func 350 end subroutine xc_func_type_free 351 end interface 352 ! 353 interface 354 type(C_PTR) function xc_get_info_name(xc_func) bind(C) 355 use, intrinsic :: iso_c_binding, only : C_PTR 356 type(C_PTR) :: xc_func 357 end function xc_get_info_name 358 end interface 359 ! 360 interface 361 type(C_PTR) function xc_get_info_refs(xc_func,iref) bind(C) 362 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 363 type(C_PTR) :: xc_func 364 integer(C_INT) :: iref 365 end function xc_get_info_refs 366 end interface 367 ! 368 interface 369 integer(C_INT) function xc_get_info_flags(xc_func) bind(C) 370 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 371 type(C_PTR) :: xc_func 372 end function xc_get_info_flags 373 end interface 374 ! 375 interface 376 integer(C_INT) function xc_get_info_kind(xc_func) bind(C) 377 use, intrinsic :: iso_c_binding, only : C_INT,C_PTR 378 type(C_PTR) :: xc_func 379 end function xc_get_info_kind 380 end interface 381 #endif 382 383 contains
libxc_functionals/libxc_functionals_check [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_check
FUNCTION
Check if the code has been compiled with libXC
INPUTS
[stop_if_error]=optional flag; if TRUE the code stops if libXC is not correctly used
SOURCE
400 function libxc_functionals_check(stop_if_error) 401 402 !Arguments ------------------------------------ 403 logical :: libxc_functionals_check 404 logical,intent(in),optional :: stop_if_error 405 !Local variables------------------------------- 406 character(len=100) :: msg 407 408 ! ************************************************************************* 409 410 libxc_functionals_check=.true. ; msg="" 411 412 #if defined HAVE_LIBXC 413 #if defined HAVE_FC_ISO_C_BINDING 414 if (.not.libxc_constants_initialized) call libxc_functionals_constants_load() 415 if (XC_SINGLE_PRECISION==1) then 416 libxc_functionals_check=.false. 417 msg='LibXC should be compiled with double precision!' 418 end if 419 #else 420 libxc_functionals_check=.false. 421 msg='LibXC cannot be used without ISO_C_BINDING support by the Fortran compiler!' 422 #endif 423 #else 424 libxc_functionals_check=.false. 425 msg='ABINIT was not compiled with LibXC support.' 426 #endif 427 428 if (present(stop_if_error)) then 429 if (stop_if_error.and.trim(msg)/="") then 430 ABI_ERROR(msg) 431 end if 432 end if 433 434 end function libxc_functionals_check
libxc_functionals/libxc_functionals_compute_tb09 [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_compute_tb09
FUNCTION
Compute c parameter for Tran-Blaha 2009 functional and set it
Applies on a (set of) functional(s)
INPUTS
npts=number of of points for the density nspden=number of spin-density components rho(npts,nspden)=electronic density grho2(npts,nspden)=squared gradient of the density
OUTPUT
SIDE EFFECTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
2125 subroutine libxc_functionals_compute_tb09(npts,nspden,rho,grho2,xc_functionals) 2126 2127 !Arguments ------------------------------------ 2128 integer, intent(in) :: npts,nspden 2129 real(dp),intent(in) :: rho(npts,nspden),grho2(npts,2*min(nspden,2)-1) 2130 type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2) 2131 !Local variables ------------------------------- 2132 !scalars 2133 integer :: ii,ipts 2134 logical :: fixed_c_tb09,is_mgga_tb09 2135 real(dp) :: cc 2136 !arrays 2137 type(libxc_functional_type),pointer :: xc_funcs(:) 2138 real(dp),allocatable :: gnon(:) 2139 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2140 integer(C_INT) :: npar_c=int(2,kind=C_INT) 2141 real(C_DOUBLE) :: param_c(2) 2142 #endif 2143 2144 ! ************************************************************************* 2145 2146 if (.not.libxc_constants_initialized) call libxc_functionals_constants_load() 2147 2148 !Select XC functional(s) 2149 if (present(xc_functionals)) then 2150 xc_funcs => xc_functionals 2151 else 2152 xc_funcs => xc_global 2153 end if 2154 2155 is_mgga_tb09=(any(xc_funcs%id==libxc_functionals_getid('XC_MGGA_X_TB09'))) 2156 fixed_c_tb09=(any(abs(xc_funcs%xc_tb09_c-99.99_dp)>tol12)) 2157 2158 if (is_mgga_tb09) then 2159 2160 ! C is fixed by the user 2161 if (fixed_c_tb09) then 2162 cc=zero 2163 do ii=1,2 2164 if (abs(xc_funcs(ii)%xc_tb09_c-99.99_dp)>tol12) cc=xc_funcs(ii)%xc_tb09_c 2165 end do 2166 ! write(msg,'(2a,f9.6)' ) ch10,& 2167 !& 'In the mGGA functional TB09, c is fixed by the user and is equal to ',cc 2168 !call wrtout(std_out,msg,'COLL') 2169 ! C is computed 2170 else 2171 ABI_MALLOC(gnon,(npts)) 2172 do ipts=1,npts 2173 if (sum(rho(ipts,:))<=1e-7_dp) then 2174 gnon(ipts)=zero 2175 else 2176 if (nspden==1) then 2177 gnon(ipts)=sqrt(grho2(ipts,1))/rho(ipts,1) 2178 else 2179 gnon(ipts)=sqrt(grho2(ipts,3))/sum(rho(ipts,:)) 2180 end if 2181 end if 2182 end do 2183 cc= -0.012_dp + 1.023_dp*sqrt(sum(gnon)/npts) 2184 ABI_FREE(gnon) 2185 ! write(msg,'(2a,f9.6)' ) ch10,'In the mGGA functional TB09, c = ',cc 2186 ! call wrtout(std_out,msg,'COLL') 2187 end if 2188 2189 ! Set c in XC data structure 2190 do ii=1,2 2191 if (xc_funcs(ii)%id==libxc_functionals_getid('XC_MGGA_X_TB09')) then 2192 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2193 param_c(1)=real(cc,kind=C_DOUBLE) ; param_c(2)=real(0._dp,kind=C_DOUBLE) 2194 call xc_func_set_params(xc_funcs(ii)%conf,param_c,npar_c) 2195 #endif 2196 end if 2197 end do 2198 end if 2199 2200 end subroutine libxc_functionals_compute_tb09
libxc_functionals/libxc_functionals_constants_load [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_constants_load
FUNCTION
Load libXC constants from C headers
SOURCE
2381 subroutine libxc_functionals_constants_load() 2382 2383 !Local variables------------------------------- 2384 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2385 integer(C_INT) :: i1,i2,i3,i4,i5,i6,i7,i8,i9 2386 #endif 2387 2388 ! ************************************************************************* 2389 2390 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2391 call xc_get_singleprecision_constant(i1) 2392 XC_SINGLE_PRECISION = int(i1) 2393 call xc_get_family_constants(i1,i2,i3,i4,i5,i6,i7,i8,i9) 2394 XC_FAMILY_UNKNOWN = int(i1) 2395 XC_FAMILY_LDA = int(i2) 2396 XC_FAMILY_GGA = int(i3) 2397 XC_FAMILY_MGGA = int(i4) 2398 XC_FAMILY_LCA = int(i5) 2399 XC_FAMILY_OEP = int(i6) 2400 XC_FAMILY_HYB_GGA = int(i7) 2401 XC_FAMILY_HYB_MGGA = int(i8) 2402 XC_FAMILY_HYB_LDA = int(i9) 2403 call xc_get_flags_constants(i1,i2,i3,i4,i5,i6) 2404 XC_FLAGS_HAVE_EXC = int(i1) 2405 XC_FLAGS_HAVE_VXC = int(i2) 2406 XC_FLAGS_HAVE_FXC = int(i3) 2407 XC_FLAGS_HAVE_KXC = int(i4) 2408 XC_FLAGS_HAVE_LXC = int(i5) 2409 XC_FLAGS_NEEDS_LAPLACIAN= int(i6) 2410 call xc_get_kind_constants(i1,i2,i3,i4) 2411 XC_EXCHANGE = int(i1) 2412 XC_CORRELATION = int(i2) 2413 XC_EXCHANGE_CORRELATION = int(i3) 2414 XC_KINETIC = int(i4) 2415 libxc_constants_initialized=.true. 2416 #endif 2417 2418 end subroutine libxc_functionals_constants_load
libxc_functionals/libxc_functionals_depends_on_temp [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_depends_on_temp
FUNCTION
Test function to identify whether a single XC functional depends on the electronic temperature or not
INPUTS
xc_functional=<type(libxc_functional_type)>, handle for XC functional
SOURCE
2268 function libxc_functionals_depends_on_temp(xc_functional) 2269 2270 !Arguments ------------------------------------ 2271 logical :: libxc_functionals_depends_on_temp 2272 type(libxc_functional_type),intent(in) :: xc_functional 2273 !Local variables------------------------------- 2274 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2275 integer(C_INT) :: ipar_c 2276 character(len=50) :: par_name 2277 character(kind=C_CHAR,len=1),pointer :: strg_c 2278 #endif 2279 2280 ! ************************************************************************* 2281 2282 libxc_functionals_depends_on_temp = .false. 2283 2284 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2285 ipar_c=0 2286 do while (ipar_c>=0) 2287 call c_f_pointer(xc_func_get_params_name(xc_functional%conf,ipar_c),strg_c) 2288 if (associated(strg_c)) then 2289 call xc_char_to_f(strg_c,par_name) 2290 if (trim(par_name)=="T") then 2291 libxc_functionals_depends_on_temp=.true. ; exit 2292 end if 2293 ipar_c=ipar_c+1 2294 else 2295 ipar_c=-1 2296 end if 2297 end do 2298 2299 if (.not.libxc_functionals_depends_on_temp) then 2300 ! For libXC_version<5, these three functional were T-dependent 2301 libxc_functionals_depends_on_temp = & 2302 & (xc_functional%id==libxc_functionals_getid('XC_LDA_XC_KSDT') .or. & 2303 & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_GDSMFB') .or. & 2304 & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_CORRKSDT')) 2305 end if 2306 2307 #else 2308 if (.False.) write(std_out,*) xc_functional%id 2309 #endif 2310 2311 end function libxc_functionals_depends_on_temp
libxc_functionals/libxc_functionals_end [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_end
FUNCTION
End usage of a (set of) XC functional(s). Call LibXC end function and deallocate module contents.
INPUTS
OUTPUT
SIDE EFFECTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
668 subroutine libxc_functionals_end(xc_functionals) 669 670 !Arguments ------------------------------------ 671 type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2) 672 !Local variables------------------------------- 673 integer :: ii 674 type(libxc_functional_type),pointer :: xc_func 675 676 ! ************************************************************************* 677 678 do ii = 1,2 679 680 ! Select XC functional 681 if (present(xc_functionals)) then 682 xc_func => xc_functionals(ii) 683 else 684 xc_func => xc_global(ii) 685 end if 686 687 if (xc_func%id <= 0) cycle 688 xc_func%id=-1 689 xc_func%family=-1 690 xc_func%kind=-1 691 xc_func%nspin=1 692 xc_func%abi_ixc=huge(0) 693 xc_func%has_exc=.false. 694 xc_func%has_vxc=.false. 695 xc_func%has_fxc=.false. 696 xc_func%has_kxc=.false. 697 xc_func%needs_laplacian=.false. 698 xc_func%is_hybrid=.false. 699 xc_func%hyb_mixing=zero 700 xc_func%hyb_mixing_sr=zero 701 xc_func%hyb_range=zero 702 xc_func%temperature=-one 703 xc_func%xc_tb09_c=99.99_dp 704 xc_func%sigma_threshold=-one 705 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 706 if (associated(xc_func%conf)) then 707 call xc_func_end(xc_func%conf) 708 call xc_func_type_free(c_loc(xc_func%conf)) 709 end if 710 #endif 711 712 end do 713 714 end subroutine libxc_functionals_end
libxc_functionals/libxc_functionals_family_from_id [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_family_from_id
FUNCTION
Return family of a XC functional from its id
INPUTS
xcid= id of a LibXC functional
SOURCE
851 function libxc_functionals_family_from_id(xcid) 852 853 !Arguments ------------------------------------ 854 integer :: libxc_functionals_family_from_id 855 integer,intent(in) :: xcid 856 !Local variables------------------------------- 857 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 858 integer(C_INT) :: xcid_c 859 #endif 860 861 ! ************************************************************************* 862 863 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 864 xcid_c=int(xcid,kind=C_INT) 865 libxc_functionals_family_from_id=int(xc_family_from_id(xcid_c,C_NULL_PTR,C_NULL_PTR)) 866 #else 867 libxc_functionals_family_from_id=-1 868 if (.false.) write(std_out,*) xcid 869 #endif 870 871 end function libxc_functionals_family_from_id
libxc_functionals/libxc_functionals_fullname [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_fullname
FUNCTION
Return full name of a (set of) XC functional(s)
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
OUTPUT
SOURCE
734 function libxc_functionals_fullname(xc_functionals) 735 736 !Arguments ------------------------------------ 737 character(len=100) :: libxc_functionals_fullname 738 type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2) 739 !Local variables------------------------------- 740 integer :: nxc 741 type(libxc_functional_type),pointer :: xc_funcs(:) 742 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 743 character(len=100) :: xcname 744 character(kind=C_CHAR,len=1),pointer :: strg_c 745 #endif 746 747 ! ************************************************************************* 748 749 libxc_functionals_fullname='No XC functional' 750 751 if (present(xc_functionals)) then 752 xc_funcs => xc_functionals 753 else 754 xc_funcs => xc_global 755 end if 756 757 nxc=size(xc_funcs) 758 if (nxc<1) return 759 760 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 761 if (nxc<2) then 762 if (xc_funcs(1)%id /= 0) then 763 call c_f_pointer(xc_functional_get_name(xc_funcs(1)%id),strg_c) 764 call xc_char_to_f(strg_c,libxc_functionals_fullname) 765 end if 766 else if (xc_funcs(1)%id <= 0) then 767 if (xc_funcs(2)%id /= 0) then 768 call c_f_pointer(xc_functional_get_name(xc_funcs(2)%id),strg_c) 769 call xc_char_to_f(strg_c,libxc_functionals_fullname) 770 end if 771 else if (xc_funcs(2)%id <= 0) then 772 if (xc_funcs(1)%id /= 0) then 773 call c_f_pointer(xc_functional_get_name(xc_funcs(1)%id),strg_c) 774 call xc_char_to_f(strg_c,libxc_functionals_fullname) 775 end if 776 else 777 call c_f_pointer(xc_functional_get_name(xc_funcs(1)%id),strg_c) 778 call xc_char_to_f(strg_c,libxc_functionals_fullname) 779 call c_f_pointer(xc_functional_get_name(xc_funcs(2)%id),strg_c) 780 call xc_char_to_f(strg_c,xcname) 781 libxc_functionals_fullname=trim(libxc_functionals_fullname)//'+'//trim(xcname) 782 end if 783 libxc_functionals_fullname=trim(libxc_functionals_fullname) 784 #endif 785 786 end function libxc_functionals_fullname
libxc_functionals/libxc_functionals_get_hybridparams [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_get_hybridparams
FUNCTION
Returns the parameters of an hybrid functional (mixing coefficient(s) and range separation) Applies on a (set of) functional(s)
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
OUTPUT
[hyb_mixing] = mixing factor of Fock contribution [hyb_mixing_sr]= mixing factor of short-range Fock contribution [hyb_range] = Range (for separation)
SOURCE
1422 subroutine libxc_functionals_get_hybridparams(hyb_mixing,hyb_mixing_sr,hyb_range,xc_functionals) 1423 1424 !Arguments ------------------------------------ 1425 real(dp),intent(out),optional :: hyb_mixing,hyb_mixing_sr,hyb_range 1426 type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2) 1427 !Local variables ------------------------------- 1428 integer :: ii 1429 character(len=500) :: msg 1430 type(libxc_functional_type),pointer :: xc_func 1431 1432 ! ************************************************************************* 1433 1434 if (present(hyb_mixing )) hyb_mixing =zero 1435 if (present(hyb_mixing_sr)) hyb_mixing_sr=zero 1436 if (present(hyb_range )) hyb_range =zero 1437 1438 do ii = 1, 2 1439 1440 ! Select XC functional 1441 if (present(xc_functionals)) then 1442 xc_func => xc_functionals(ii) 1443 else 1444 xc_func => xc_global(ii) 1445 end if 1446 1447 ! Mixing coefficient for the Fock contribution 1448 if (present(hyb_mixing)) then 1449 if (abs(xc_func%hyb_mixing) > tol8) then 1450 if (abs(hyb_mixing) <= tol8) then 1451 hyb_mixing=xc_func%hyb_mixing 1452 else 1453 msg='Invalid XC functional: contains 2 hybrid exchange functionals!' 1454 ABI_ERROR(msg) 1455 end if 1456 end if 1457 end if 1458 1459 ! Mixing coefficient for the short-range Fock contribution 1460 if (present(hyb_mixing_sr)) then 1461 if (abs(xc_func%hyb_mixing_sr) > tol8) then 1462 if (abs(hyb_mixing_sr) <= tol8) then 1463 hyb_mixing_sr=xc_func%hyb_mixing_sr 1464 else 1465 msg='Invalid XC functional: contains 2 hybrid exchange functionals!' 1466 ABI_ERROR(msg) 1467 end if 1468 end if 1469 end if 1470 1471 ! Range separation 1472 if (present(hyb_range)) then 1473 if (abs(xc_func%hyb_range) > tol8) then 1474 if (abs(hyb_range) <= tol8) then 1475 hyb_range=xc_func%hyb_range 1476 else 1477 msg='Invalid XC functional: contains 2 hybrid exchange functionals!' 1478 ABI_ERROR(msg) 1479 end if 1480 end if 1481 end if 1482 1483 end do 1484 1485 end subroutine libxc_functionals_get_hybridparams
libxc_functionals/libxc_functionals_getid [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_getid
FUNCTION
Return identifer of a XC functional from its name Return -1 if undefined
INPUTS
xcname= string containing the name of a XC functional
SOURCE
804 function libxc_functionals_getid(xcname) 805 806 !Arguments ------------------------------------ 807 integer :: libxc_functionals_getid 808 character(len=*),intent(in) :: xcname 809 !Local variables------------------------------- 810 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 811 character(len=256) :: str 812 character(kind=C_CHAR,len=1),target :: name_c(len_trim(xcname)+1) 813 character(kind=C_CHAR,len=1),target :: name_c_xc(len_trim(xcname)-2) 814 type(C_PTR) :: name_c_ptr 815 #endif 816 817 ! ************************************************************************* 818 819 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 820 str=trim(xcname) 821 if (xcname(1:3)=="XC_".or.xcname(1:3)=="xc_") then 822 str=xcname(4:);name_c_xc=xc_char_to_c(str) 823 name_c_ptr=c_loc(name_c_xc) 824 else 825 name_c=xc_char_to_c(str) 826 name_c_ptr=c_loc(name_c) 827 end if 828 libxc_functionals_getid=int(xc_functional_get_number(name_c_ptr)) 829 #else 830 libxc_functionals_getid=-1 831 if (.false.) write(std_out,*) xcname 832 #endif 833 834 end function libxc_functionals_getid
libxc_functionals/libxc_functionals_getrefs [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_getrefs
FUNCTION
Return the reference(s) of a single XC functional
INPUTS
xc_functional=<type(libxc_functional_type)>, handle for XC functional
OUTPUT
xcrefs(:)= references(s) of the functional
SOURCE
2220 subroutine libxc_functionals_getrefs(xcrefs,xc_functional) 2221 2222 !Arguments ------------------------------------ 2223 character(len=*),intent(out) :: xcrefs(:) 2224 type(libxc_functional_type),intent(in) :: xc_functional 2225 !Local variables------------------------------- 2226 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2227 integer(C_INT) :: iref_c 2228 character(kind=C_CHAR,len=1),pointer :: strg_c 2229 #endif 2230 2231 ! ************************************************************************* 2232 2233 xcrefs(:)='' 2234 2235 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2236 iref_c=0 2237 do while (iref_c>=0.and.iref_c<size(xcrefs)) 2238 call c_f_pointer(xc_get_info_refs(xc_functional%conf,iref_c),strg_c) 2239 if (associated(strg_c)) then 2240 call xc_char_to_f(strg_c,xcrefs(iref_c+1)) 2241 iref_c=iref_c+1 2242 else 2243 iref_c=-1 2244 end if 2245 end do 2246 #else 2247 if (.False.) write(std_out,*) xc_functional%id 2248 #endif 2249 2250 end subroutine libxc_functionals_getrefs
libxc_functionals/libxc_functionals_getvxc [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_getvxc
FUNCTION
Return XC potential and energy, from input density (gradient etc...)
INPUTS
ndvxc=size of dvxc nd2vxc=size of d2vxc npts=number of of points for the density nspden=number of spin-density components order=requested order of derivation rho(npts,nspden)=electronic density [grho2(npts,nspden)]=squared gradient of the density [lrho(npts,nspden)]=laplacian of the density [tau(npts,nspden)]= kinetic energy density
OUTPUT
exc(npts)=XC energy density vxc(npts,nspden)=derivative of the energy density wrt to the density [vxclrho(npts,nspden)]=derivative of the energy density wrt to the density laplacian [vxctau(npts,nspden)]=derivative of the energy density wrt to the kinetic energy density [dvxc(npts,ndvxc)]=2nd derivative of the energy density wrt to the density [vxcgr(npts,3)]=2nd derivative of the energy density wrt to the gradient 2nd derivative of the energy density wrt to the density and the gradient [d2vxc(npts,nd2vxc)]=3rd derivative of the energy density wrt to the density
SIDE EFFECTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1762 subroutine libxc_functionals_getvxc(ndvxc,nd2vxc,npts,nspden,order,rho,exc,vxc,& 1763 & grho2,vxcgr,lrho,vxclrho,tau,vxctau,dvxc,d2vxc,xc_functionals) ! Optional arguments 1764 1765 !Arguments ------------------------------------ 1766 integer, intent(in) :: ndvxc,nd2vxc,npts,nspden,order 1767 real(dp),intent(in) :: rho(npts,nspden) 1768 real(dp),intent(out) :: vxc(npts,nspden),exc(npts) 1769 real(dp),intent(in),optional :: grho2(npts,2*min(nspden,2)-1) 1770 real(dp),intent(out),optional :: vxcgr(npts,3) 1771 real(dp),intent(in),optional :: lrho(npts,nspden) 1772 real(dp),intent(out),optional :: vxclrho(npts,nspden) 1773 real(dp),intent(in),optional :: tau(npts,nspden) 1774 real(dp),intent(out),optional :: vxctau(npts,nspden) 1775 real(dp),intent(out),optional :: dvxc(npts,ndvxc) 1776 real(dp),intent(out),optional :: d2vxc(npts,nd2vxc) 1777 type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2) 1778 !Local variables ------------------------------- 1779 !scalars 1780 integer :: ii,ipts 1781 logical :: is_gga,is_mgga,needs_laplacian,has_sigma_threshold 1782 real(dp),target :: exctmp 1783 character(len=500) :: msg 1784 real(dp) :: sigma_threshold_max 1785 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1786 type(C_PTR) :: rho_c,sigma_c,lrho_c,tau_c 1787 #endif 1788 !arrays 1789 real(dp),target :: rhotmp(nspden),sigma(3),vxctmp(nspden),vsigma(3) 1790 real(dp),target :: v2rho2(3),v2rhosigma(6),v2sigma2(6) 1791 real(dp),target :: v2rholapl(3),v2sigmalapl(6),v2lapl2(3) 1792 real(dp),target :: v2rhotau(3),v2sigmatau(6),v2lapltau(3),v2tau2(3) 1793 real(dp),target :: v3rho3(4),v3rho2sigma(9),v3rhosigma2(12),v3sigma3(10) 1794 real(dp),target :: lrhotmp(nspden),tautmp(nspden),vlrho(nspden),vtau(nspden) 1795 type(libxc_functional_type),pointer :: xc_funcs(:) 1796 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1797 type(C_PTR) :: exc_c(2),vxc_c(2),vsigma_c(2),vlrho_c(2),vtau_c(2) 1798 type(C_PTR) :: v2rho2_c(2),v2rhosigma_c(2),v2sigma2_c(2) 1799 type(C_PTR) :: v2rholapl_c(2),v2sigmalapl_c(2),v2lapl2_c(2) 1800 type(C_PTR) :: v2rhotau_c(2),v2sigmatau_c(2),v2lapltau_c(2),v2tau2_c(2) 1801 type(C_PTR) :: v3rho3_c(2),v3rho2sigma_c(2),v3rhosigma2_c(2),v3sigma3_c(2) 1802 #endif 1803 1804 ! ************************************************************************* 1805 1806 if (.not.libxc_constants_initialized) call libxc_functionals_constants_load() 1807 1808 !Select XC functional(s) 1809 if (present(xc_functionals)) then 1810 xc_funcs => xc_functionals 1811 else 1812 xc_funcs => xc_global 1813 end if 1814 1815 is_gga =libxc_functionals_isgga (xc_funcs) 1816 is_mgga=libxc_functionals_ismgga(xc_funcs) 1817 needs_laplacian=(libxc_functionals_needs_laplacian(xc_funcs).and.present(lrho)) 1818 1819 sigma_threshold_max=maxval(xc_funcs(:)%sigma_threshold,mask=(xc_funcs(:)%id>0)) 1820 has_sigma_threshold=(sigma_threshold_max>zero) 1821 1822 if (is_gga.and.(.not.present(grho2))) then 1823 msg='GGA needs gradient of density!' 1824 ABI_BUG(msg) 1825 end if 1826 if (is_mgga) then 1827 if (present(vxctau).and.(.not.present(tau))) then 1828 msg='meta-GGA needs tau!' 1829 ABI_BUG(msg) 1830 end if 1831 if (needs_laplacian) then 1832 if (present(vxclrho).and.(.not.present(lrho))) then 1833 msg='meta-GGA needs lrho!' 1834 ABI_BUG(msg) 1835 end if 1836 end if 1837 endif 1838 1839 !Inititalize all output arrays to zero 1840 exc=zero ; vxc=zero 1841 if (present(dvxc)) dvxc=zero 1842 if (present(d2vxc)) d2vxc=zero 1843 if ((is_gga.or.is_mgga).and.present(vxcgr)) vxcgr=zero 1844 if (is_mgga.and.present(vxclrho)) vxclrho=zero 1845 if (is_mgga.and.present(vxctau)) vxctau=zero 1846 1847 !Determine which XC outputs can be computed 1848 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1849 do ii = 1,2 1850 if (xc_funcs(ii)%has_exc) then 1851 exc_c(ii)=c_loc(exctmp) 1852 else 1853 exc_c(ii)=C_NULL_PTR 1854 end if 1855 if (xc_funcs(ii)%has_vxc) then 1856 vxc_c(ii)=c_loc(vxctmp) 1857 vsigma_c(ii)=c_loc(vsigma) 1858 vtau_c(ii)=c_loc(vtau) 1859 vlrho_c(ii)=c_loc(vlrho) 1860 else 1861 vxc_c(ii)=C_NULL_PTR 1862 vsigma_c(ii)=c_NULL_PTR 1863 vtau_c(ii)=C_NULL_PTR 1864 vlrho_c(ii)=C_NULL_PTR 1865 end if 1866 if ((xc_funcs(ii)%has_fxc).and.(abs(order)>1)) then 1867 v2rho2_c(ii)=c_loc(v2rho2) 1868 v2sigma2_c(ii)=c_loc(v2sigma2) 1869 v2rhosigma_c(ii)=c_loc(v2rhosigma) 1870 if (is_mgga) then 1871 v2rholapl_c(ii)=c_loc(v2rholapl) 1872 v2sigmalapl_c(ii)=c_loc(v2sigmalapl) 1873 v2lapl2_c(ii)=c_loc(v2lapl2) 1874 v2rhotau_c(ii)=c_loc(v2rhotau) 1875 v2sigmatau_c(ii)=c_loc(v2sigmatau) 1876 v2lapltau_c(ii)=c_loc(v2lapltau) 1877 v2tau2_c(ii)=c_loc(v2tau2) 1878 end if 1879 else 1880 v2rho2_c(ii)=C_NULL_PTR 1881 v2sigma2_c(ii)=C_NULL_PTR 1882 v2rhosigma_c(ii)=C_NULL_PTR 1883 if (is_mgga) then 1884 v2rholapl_c(ii)=C_NULL_PTR 1885 v2sigmalapl_c(ii)=C_NULL_PTR 1886 v2lapl2_c(ii)=C_NULL_PTR 1887 v2rhotau_c(ii)=C_NULL_PTR 1888 v2sigmatau_c(ii)=C_NULL_PTR 1889 v2lapltau_c(ii)=C_NULL_PTR 1890 v2tau2_c(ii)=C_NULL_PTR 1891 end if 1892 end if 1893 if ((xc_funcs(ii)%has_kxc).and.(abs(order)>2)) then 1894 v3rho3_c(ii)=c_loc(v3rho3) 1895 v3sigma3_c(ii)=c_loc(v3sigma3) 1896 v3rho2sigma_c(ii)=c_loc(v3rho2sigma) 1897 v3rhosigma2_c(ii)=c_loc(v3rhosigma2) 1898 else 1899 v3rho3_c(ii)=C_NULL_PTR 1900 v3sigma3_c(ii)=C_NULL_PTR 1901 v3rho2sigma_c(ii)=C_NULL_PTR 1902 v3rhosigma2_c(ii)=C_NULL_PTR 1903 end if 1904 end do 1905 #endif 1906 1907 !Initialize temporary arrays 1908 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1909 rhotmp=zero ; rho_c=c_loc(rhotmp) 1910 if (is_gga.or.is_mgga) then 1911 sigma=zero ; sigma_c=c_loc(sigma) 1912 end if 1913 if (is_mgga) then 1914 tautmp=zero ; tau_c=c_loc(tautmp) 1915 lrhotmp=zero ;lrho_c=c_loc(lrhotmp) 1916 end if 1917 #endif 1918 1919 !Some mGGA functionals require a special treatment 1920 if (is_mgga) then 1921 !TB09 functional requires the c parameter to be set 1922 call libxc_functionals_compute_tb09(npts,nspden,rho,grho2,xc_funcs) 1923 end if 1924 1925 !Loop over points 1926 do ipts=1,npts 1927 1928 ! Convert the quantities provided by ABINIT to the ones needed by libxc 1929 if (nspden == 1) then 1930 ! ABINIT passes rho_up in the spin-unpolarized case, while the libxc 1931 ! expects the total density 1932 rhotmp(1:nspden) = two*rho(ipts,1:nspden) 1933 else 1934 rhotmp(1:nspden) = rho(ipts,1:nspden) 1935 end if 1936 if (is_gga.or.is_mgga) then 1937 if (nspden==1) then 1938 ! ABINIT passes |grho_up|^2 while Libxc needs |grho_tot|^2 1939 sigma(1) = four*grho2(ipts,1) 1940 else 1941 ! ABINIT passes |grho_up|^2, |grho_dn|^2, and |grho_tot|^2 1942 ! while Libxc needs |grho_up|^2, grho_up.grho_dn, and |grho_dn|^2 1943 sigma(1) = grho2(ipts,1) 1944 sigma(2) = (grho2(ipts,3) - grho2(ipts,1) - grho2(ipts,2))/two 1945 sigma(3) = grho2(ipts,2) 1946 end if 1947 ! Apply a threshold on sigma (cannot be done in libxc6, at present) 1948 if (has_sigma_threshold) then 1949 do ii=1,2*nspden-1 1950 if (abs(sigma(ii))<=sigma_threshold_max) sigma(ii)=sigma_threshold_max 1951 end do 1952 end if 1953 end if 1954 if (is_mgga) then 1955 if (nspden==1) then 1956 tautmp(1:nspden) = two*tau(ipts,1:nspden) 1957 if (needs_laplacian) lrhotmp(1:nspden) = two*lrho(ipts,1:nspden) 1958 else 1959 tautmp(1:nspden) = tau(ipts,1:nspden) 1960 if (needs_laplacian) lrhotmp(1:nspden) = lrho(ipts,1:nspden) 1961 end if 1962 end if 1963 1964 ! Loop over functionals 1965 do ii = 1,2 1966 if (xc_funcs(ii)%id<=0) cycle 1967 1968 ! Get the energy and the potential (and possibly the other derivatives) 1969 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1970 exctmp=zero ; vxctmp=zero 1971 ! ===== LDA ===== 1972 if (xc_funcs(ii)%family==XC_FAMILY_LDA) then 1973 exctmp=zero ; vxctmp=zero ; v2rho2=zero ; v3rho3=zero 1974 call xc_get_lda(xc_funcs(ii)%conf,1,rho_c, & 1975 & exc_c(ii),vxc_c(ii),v2rho2_c(ii),v3rho3_c(ii)) 1976 ! ===== GGA ===== 1977 else if (xc_funcs(ii)%family==XC_FAMILY_GGA.or. & 1978 & xc_funcs(ii)%family==XC_FAMILY_HYB_GGA) then 1979 exctmp=zero ; vxctmp=zero ; vsigma=zero 1980 v2rho2=zero ; v2sigma2=zero ; v2rhosigma=zero 1981 v3rho3=zero ; v3rho2sigma=zero ; v3rhosigma2=zero ; v3sigma3=zero 1982 call xc_get_gga(xc_funcs(ii)%conf,1,rho_c,sigma_c, & 1983 & exc_c(ii),vxc_c(ii),vsigma_c(ii), & 1984 & v2rho2_c(ii),v2rhosigma_c(ii),v2sigma2_c(ii), & 1985 & v3rho3_c(ii),v3rho2sigma_c(ii),v3rhosigma2_c(ii),v3sigma3_c(ii)) 1986 ! ===== mGGA ===== 1987 else if (xc_funcs(ii)%family==XC_FAMILY_MGGA.or. & 1988 & xc_funcs(ii)%family==XC_FAMILY_HYB_MGGA) then 1989 exctmp=zero ; vxctmp=zero ; vsigma=zero ; vlrho=zero ; vtau=zero 1990 v2rho2=zero ; v2sigma2=zero ; v2rhosigma=zero 1991 ! At present, we don't use 2nd derivatives involving Tau or Laplacian 1992 call xc_get_mgga(xc_funcs(ii)%conf,1,rho_c,sigma_c,lrho_c,tau_c, & 1993 & exc_c(ii),vxc_c(ii),vsigma_c(ii),vlrho_c(ii),vtau_c(ii), & 1994 & v2rho2_c(ii),v2rhosigma_c(ii),v2rholapl_c(ii),v2rhotau_c(ii),v2sigma2_c(ii), & 1995 & v2sigmalapl_c(ii),v2sigmatau_c(ii),v2lapl2_c(ii),v2lapltau_c(ii),v2tau2_c(ii)) 1996 end if 1997 #endif 1998 1999 exc(ipts) = exc(ipts) + exctmp 2000 vxc(ipts,1:nspden) = vxc(ipts,1:nspden) + vxctmp(1:nspden) 2001 2002 ! Deal with fxc and kxc 2003 if (abs(order)>1) then 2004 ! ----- LDA ----- 2005 if (xc_funcs(ii)%family==XC_FAMILY_LDA) then 2006 if (nspden==1) then 2007 if(order>=2) then 2008 dvxc(ipts,1)=dvxc(ipts,1)+v2rho2(1) 2009 if(order>2) then 2010 d2vxc(ipts,1)=d2vxc(ipts,1)+v3rho3(1) 2011 endif 2012 else if (order==-2) then 2013 dvxc(ipts,1)=dvxc(ipts,1)+v2rho2(1) 2014 dvxc(ipts,2)=dvxc(ipts,2)+v2rho2(1) 2015 endif 2016 else 2017 dvxc(ipts,1)=dvxc(ipts,1)+v2rho2(1) 2018 dvxc(ipts,2)=dvxc(ipts,2)+v2rho2(2) 2019 dvxc(ipts,3)=dvxc(ipts,3)+v2rho2(3) 2020 if(abs(order)>2) then 2021 d2vxc(ipts,1)=d2vxc(ipts,1)+v3rho3(1) 2022 d2vxc(ipts,2)=d2vxc(ipts,2)+v3rho3(2) 2023 d2vxc(ipts,3)=d2vxc(ipts,3)+v3rho3(3) 2024 d2vxc(ipts,4)=d2vxc(ipts,4)+v3rho3(4) 2025 endif 2026 endif 2027 ! ----- GGA or mGGA ----- 2028 else if (xc_funcs(ii)%family==XC_FAMILY_GGA.or. & 2029 & xc_funcs(ii)%family==XC_FAMILY_HYB_GGA.or. & 2030 & xc_funcs(ii)%family==XC_FAMILY_MGGA.or. & 2031 & xc_funcs(ii)%family==XC_FAMILY_HYB_MGGA) then 2032 if (xc_funcs(ii)%kind==XC_EXCHANGE) then 2033 if (nspden==1) then 2034 dvxc(ipts,1)=v2rho2(1)*two 2035 dvxc(ipts,2)=dvxc(ipts,1) 2036 dvxc(ipts,3)=two*two*vsigma(1) 2037 dvxc(ipts,4)=dvxc(ipts,3) 2038 dvxc(ipts,5)=four*two*v2rhosigma(1) 2039 dvxc(ipts,6)=dvxc(ipts,5) 2040 dvxc(ipts,7)=two*four*four*v2sigma2(1) 2041 dvxc(ipts,8)=dvxc(ipts,7) 2042 else 2043 dvxc(ipts,1)=v2rho2(1) 2044 dvxc(ipts,2)=v2rho2(3) 2045 dvxc(ipts,3)=two*vsigma(1) 2046 dvxc(ipts,4)=two*vsigma(3) 2047 dvxc(ipts,5)=two*v2rhosigma(1) 2048 dvxc(ipts,6)=two*v2rhosigma(6) 2049 dvxc(ipts,7)=four*v2sigma2(1) 2050 dvxc(ipts,8)=four*v2sigma2(6) 2051 end if 2052 else if (xc_funcs(ii)%kind==XC_CORRELATION) then 2053 if (nspden==1) then 2054 dvxc(ipts,9)=v2rho2(1) 2055 dvxc(ipts,10)=dvxc(ipts,9) 2056 dvxc(ipts,11)=dvxc(ipts,9) 2057 dvxc(ipts,12)=two*vsigma(1) 2058 dvxc(ipts,13)=two*v2rhosigma(1) 2059 dvxc(ipts,14)=dvxc(ipts,13) 2060 dvxc(ipts,15)=four*v2sigma2(1) 2061 else 2062 dvxc(ipts,9)=v2rho2(1) 2063 dvxc(ipts,10)=v2rho2(2) 2064 dvxc(ipts,11)=v2rho2(3) 2065 dvxc(ipts,12)=two*vsigma(1) 2066 dvxc(ipts,13)=two*v2rhosigma(1) 2067 dvxc(ipts,14)=two*v2rhosigma(6) 2068 dvxc(ipts,15)=four*v2sigma2(1) 2069 end if 2070 end if 2071 end if 2072 end if 2073 2074 ! Convert the quantities returned by Libxc to the ones needed by ABINIT 2075 if ((is_gga.or.is_mgga).and.present(vxcgr)) then 2076 if (nspden==1) then 2077 vxcgr(ipts,3) = vxcgr(ipts,3) + vsigma(1)*two 2078 else 2079 vxcgr(ipts,1) = vxcgr(ipts,1) + two*vsigma(1) - vsigma(2) 2080 vxcgr(ipts,2) = vxcgr(ipts,2) + two*vsigma(3) - vsigma(2) 2081 vxcgr(ipts,3) = vxcgr(ipts,3) + vsigma(2) 2082 end if 2083 end if 2084 if (is_mgga.and.present(vxctau)) then 2085 vxctau(ipts,1:nspden) = vxctau(ipts,1:nspden) + vtau(1:nspden) 2086 end if 2087 if (is_mgga.and.needs_laplacian.and.present(vxclrho)) then 2088 vxclrho(ipts,1:nspden) = vxclrho(ipts,1:nspden) + vlrho(1:nspden) 2089 end if 2090 2091 end do ! ii 2092 end do ! ipts 2093 2094 end subroutine libxc_functionals_getvxc
libxc_functionals/libxc_functionals_gga_from_hybrid [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_gga_from_hybrid
FUNCTION
Returns a logical flag: TRUE if one can deduce, from the id of a hybrid functional set, the id(s) of the GGA functional on which it is based. Optionally returns the id of the GGA functional on which the hybrid functional is based (2 integers defining the GGA X and C functionals). - If an id is provided as input argument, it is used as input id; - If not, the input id is taken from the optional xc_functionals datastructure; - If no input argument is given, the input id is taken from the global xc_global datastructure.
INPUTS
[hybrid_id]=<type(libxc_functional_type)>, optional : id of an input hybrid functional
[xc_functionals(2)]=<type(libxc_functional_type)>, optional : XC functionals from which
the id(s) can be used
OUTPUT
[gga_id(2)]=array that contains the GGA libXC id(s) libxc_functionals_gga_from_hybrid=.true. if the GGA has been found from the input id
SOURCE
1622 function libxc_functionals_gga_from_hybrid(gga_id,hybrid_id,xc_functionals) 1623 1624 !Arguments ------------------------------------ 1625 !scalars 1626 integer,intent(in),optional :: hybrid_id 1627 logical :: libxc_functionals_gga_from_hybrid 1628 !arrays 1629 integer,intent(out),optional :: gga_id(2) 1630 type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2) 1631 !Local variables ------------------------------- 1632 !scalars 1633 integer :: ii 1634 logical :: is_hybrid 1635 character(len=100) :: c_name,x_name,msg 1636 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1637 character(len=100) :: xc_name 1638 character(kind=C_CHAR,len=1),pointer :: strg_c 1639 #endif 1640 !arrays 1641 integer :: trial_id(2) 1642 1643 ! ************************************************************************* 1644 1645 libxc_functionals_gga_from_hybrid=.false. 1646 1647 is_hybrid=.false. 1648 if (present(hybrid_id)) then 1649 trial_id(1)=hybrid_id 1650 trial_id(2)=0 1651 is_hybrid=libxc_functionals_is_hybrid_from_id(trial_id(1)) 1652 else if (present(xc_functionals)) then 1653 trial_id(1)=xc_functionals(1)%id 1654 trial_id(2)=xc_functionals(2)%id 1655 is_hybrid=libxc_functionals_is_hybrid(xc_functionals) 1656 else 1657 trial_id(1)=xc_global(1)%id 1658 trial_id(2)=xc_global(2)%id 1659 is_hybrid=libxc_functionals_is_hybrid(xc_global) 1660 end if 1661 1662 c_name="unknown" ; x_name="unknown" 1663 1664 !Specific treatment of the B3LYP functional, whose GGA counterpart does not exist in LibXC 1665 if (trial_id(1)==402 .or. trial_id(2)==402) then 1666 libxc_functionals_gga_from_hybrid=.true. 1667 if (present(gga_id)) then 1668 gga_id(1)=0 1669 gga_id(2)=-1402 ! This corresponds to a native ABINIT functional, 1670 ! actually a composite from different LibXC functionals! 1671 write(std_out,*)' libxc_functionals_gga_from_hybrid, return with gga_id=',gga_id 1672 endif 1673 return 1674 endif 1675 1676 do ii = 1, 2 1677 1678 if ((trial_id(ii)<=0).or.(.not.is_hybrid)) cycle 1679 1680 if (libxc_functionals_gga_from_hybrid) then 1681 msg='Invalid XC functional setup: contains 2 hybrid functionals!' 1682 ABI_ERROR(msg) 1683 end if 1684 1685 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1686 1687 call c_f_pointer(xc_functional_get_name(trial_id(ii)),strg_c) 1688 call xc_char_to_f(strg_c,xc_name) 1689 1690 ! AVAILABLE FUNCTIONALS 1691 1692 ! ===== PBE0 ===== 1693 if (xc_name=="hyb_gga_xc_pbeh" .or. & 1694 & xc_name=="hyb_gga_xc_pbe0_13") then 1695 c_name="GGA_C_PBE" 1696 x_name="GGA_X_PBE" 1697 libxc_functionals_gga_from_hybrid=.true. 1698 1699 ! ===== HSE ===== 1700 else if (xc_name=="hyb_gga_xc_hse03" .or. & 1701 & xc_name=="hyb_gga_xc_hse06" ) then 1702 c_name="GGA_C_PBE" 1703 x_name="GGA_X_PBE" 1704 libxc_functionals_gga_from_hybrid=.true. 1705 end if 1706 1707 1708 #endif 1709 1710 enddo ! ii 1711 1712 if (present(gga_id)) then 1713 if (libxc_functionals_gga_from_hybrid) then 1714 gga_id(1)=libxc_functionals_getid(c_name) 1715 gga_id(2)=libxc_functionals_getid(x_name) 1716 else 1717 gga_id(:)=-1 1718 end if 1719 end if 1720 1721 !Note that in the case of B3LYP functional, the return happened immediately after the setup of B3LYP parameters. 1722 1723 end function libxc_functionals_gga_from_hybrid
libxc_functionals/libxc_functionals_has_k3xc [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_has_k3xc
FUNCTION
Test function to identify whether the presently used (set of) functional(s) provides K3xc or not (kxc in the libXC convention)
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1272 function libxc_functionals_has_k3xc(xc_functionals) 1273 1274 !Arguments ------------------------------------ 1275 logical :: libxc_functionals_has_k3xc 1276 type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2) 1277 !Local variables------------------------------- 1278 integer :: ii 1279 1280 ! ************************************************************************* 1281 1282 libxc_functionals_has_k3xc=.true. 1283 1284 do ii=1,2 1285 if (present(xc_functionals)) then 1286 if (.not.xc_functionals(ii)%has_kxc) libxc_functionals_has_k3xc=.false. 1287 else 1288 if (.not.xc_global(ii)%has_kxc) libxc_functionals_has_k3xc=.false. 1289 end if 1290 end do 1291 1292 end function libxc_functionals_has_k3xc
libxc_functionals/libxc_functionals_has_kxc [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_has_kxc
FUNCTION
Test function to identify whether the presently used (set of) functional(s) provides Kxc or not (fxc in the libXC convention)
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1233 function libxc_functionals_has_kxc(xc_functionals) 1234 1235 !Arguments ------------------------------------ 1236 logical :: libxc_functionals_has_kxc 1237 type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2) 1238 !Local variables------------------------------- 1239 integer :: ii 1240 1241 ! ************************************************************************* 1242 1243 libxc_functionals_has_kxc=.true. 1244 1245 do ii=1,2 1246 if (present(xc_functionals)) then 1247 if (.not.xc_functionals(ii)%has_fxc) libxc_functionals_has_kxc=.false. 1248 else 1249 if (.not.xc_global(ii)%has_fxc) libxc_functionals_has_kxc=.false. 1250 end if 1251 end do 1252 1253 end function libxc_functionals_has_kxc
libxc_functionals/libxc_functionals_init [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_init
FUNCTION
Initialize the desired (set of) XC functional(s), from LibXC. * Call the LibXC initializer * Fill preliminary fields in module structures.
INPUTS
ixc=XC code for Abinit nspden=number of spin-density components [el_temp]=electronic temperature (optional, only for specific functionals) [xc_tb09_c]=special argument for the Tran-Blaha 2009 functional
OUTPUT
SIDE EFFECTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
462 subroutine libxc_functionals_init(ixc,nspden,xc_functionals,& 463 & el_temp,xc_tb09_c) ! optional arguments 464 465 !Arguments ------------------------------------ 466 integer, intent(in) :: nspden 467 integer, intent(in) :: ixc 468 real(dp),intent(in),optional :: el_temp,xc_tb09_c 469 type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2) 470 !Local variables------------------------------- 471 integer :: ii,jj,nspden_eff 472 character(len=500) :: msg 473 type(libxc_functional_type),pointer :: xc_func 474 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 475 integer :: flags 476 integer(C_INT) :: func_id_c,iref_c,npar_c,nspin_c,success_c 477 real(C_DOUBLE) :: alpha_c,beta_c,omega_c,param_c(1) 478 character(kind=C_CHAR,len=1),pointer :: strg_c 479 type(C_PTR) :: func_ptr_c 480 #endif 481 482 ! ************************************************************************* 483 484 !Check libXC 485 if (.not.libxc_functionals_check(stop_if_error=.true.)) return 486 if (.not.libxc_constants_initialized)then 487 call libxc_functionals_constants_load() 488 endif 489 490 nspden_eff=min(nspden,2) 491 492 !Select XC functional(s) identifiers 493 if (present(xc_functionals)) then 494 xc_functionals(1)%id = -ixc/1000 495 xc_functionals(2)%id = -ixc + (ixc/1000)*1000 496 else 497 xc_global(1)%id = -ixc/1000 498 xc_global(2)%id = -ixc + (ixc/1000)*1000 499 end if 500 501 do ii = 1,2 502 503 ! Select XC functional 504 if (present(xc_functionals)) then 505 xc_func => xc_functionals(ii) 506 else 507 xc_func => xc_global(ii) 508 end if 509 510 xc_func%abi_ixc=ixc !Save abinit value for reference 511 512 xc_func%family=XC_FAMILY_UNKNOWN 513 xc_func%kind=-1 514 xc_func%nspin=nspden_eff 515 xc_func%has_exc=.false. 516 xc_func%has_vxc=.false. 517 xc_func%has_fxc=.false. 518 xc_func%has_kxc=.false. 519 xc_func%needs_laplacian=.false. 520 xc_func%is_hybrid=.false. 521 xc_func%hyb_mixing=zero 522 xc_func%hyb_mixing_sr=zero 523 xc_func%hyb_range=zero 524 xc_func%temperature=-one 525 xc_func%xc_tb09_c=99.99_dp 526 xc_func%sigma_threshold=-one 527 528 if (xc_func%id<=0) cycle 529 530 ! Get XC functional family 531 xc_func%family=libxc_functionals_family_from_id(xc_func%id) 532 if (xc_func%family/=XC_FAMILY_LDA .and. & 533 & xc_func%family/=XC_FAMILY_GGA .and. & 534 & xc_func%family/=XC_FAMILY_MGGA.and. & 535 & xc_func%family/=XC_FAMILY_HYB_GGA) then 536 write(msg, '(a,i8,2a,i8,a,i8,3a,i8,6a)' )& 537 & 'Invalid IXC = ',ixc,ch10,& 538 & 'Current xc_func%id=',xc_func%id,', (ii=',ii,')',ch10,& 539 & 'The associated LibXC functional family ',xc_func%family,& 540 & ' is currently unsupported by ABINIT',ch10,& 541 & '(-1 means the family is unknown to the LibXC itself)',ch10,& 542 & 'Please consult the LibXC documentation',ch10 543 ABI_ERROR(msg) 544 end if 545 546 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 547 548 ! Allocate functional 549 func_ptr_c=xc_func_type_malloc() 550 call c_f_pointer(func_ptr_c,xc_func%conf) 551 552 ! Initialize functional 553 func_id_c=int(xc_func%id,kind=C_INT) 554 nspin_c=int(nspden_eff,kind=C_INT) 555 success_c=xc_func_init(xc_func%conf,func_id_c,nspin_c) 556 if (success_c/=0) then 557 msg='Error in libXC functional initialization!' 558 ABI_ERROR(msg) 559 end if 560 561 ! Special treatment for LDA_C_XALPHA functional 562 if (xc_func%id==libxc_functionals_getid('XC_LDA_C_XALPHA')) then 563 param_c(1)=real(zero,kind=C_DOUBLE);npar_c=int(1,kind=C_INT) 564 call xc_func_set_params(xc_func%conf,param_c,npar_c) 565 end if 566 567 ! Special treatment for XC_MGGA_X_TB09 functional 568 if (xc_func%id==libxc_functionals_getid('XC_MGGA_X_TB09')) then 569 if (.not.present(xc_tb09_c)) then 570 msg='xc_tb09_c argument is mandatory for TB09 functional!' 571 ABI_BUG(msg) 572 end if 573 xc_func%xc_tb09_c=xc_tb09_c 574 end if 575 576 ! Get functional kind 577 xc_func%kind=int(xc_get_info_kind(xc_func%conf)) 578 579 ! Get functional flags 580 flags=int(xc_get_info_flags(xc_func%conf)) 581 xc_func%has_exc=(iand(flags,XC_FLAGS_HAVE_EXC)>0) 582 xc_func%has_vxc=(iand(flags,XC_FLAGS_HAVE_VXC)>0) 583 xc_func%has_fxc=(iand(flags,XC_FLAGS_HAVE_FXC)>0) 584 xc_func%has_kxc=(iand(flags,XC_FLAGS_HAVE_KXC)>0) 585 586 ! Retrieve parameters for metaGGA functionals 587 if (xc_func%family==XC_FAMILY_MGGA.or. & 588 & xc_func%family==XC_FAMILY_HYB_MGGA) then 589 xc_func%needs_laplacian=(iand(flags,XC_FLAGS_NEEDS_LAPLACIAN)>0) 590 end if 591 592 ! Retrieve parameters for hybrid functionals 593 xc_func%is_hybrid=(xc_func_is_hybrid_from_id(xc_func%id)==1) 594 if (xc_func%is_hybrid) then 595 call xc_hyb_cam_coef(xc_func%conf,omega_c,alpha_c,beta_c) 596 xc_func%hyb_mixing=real(alpha_c,kind=dp) 597 xc_func%hyb_mixing_sr=real(beta_c,kind=dp) 598 xc_func%hyb_range=real(omega_c,kind=dp) 599 end if 600 601 ! Possible temperature dependence 602 if (present(el_temp)) then 603 if (el_temp>tol10) then 604 if (libxc_functionals_depends_on_temp(xc_func)) then 605 xc_func%temperature=el_temp 606 call libxc_functionals_set_temp(xc_func,el_temp) 607 end if 608 end if 609 end if 610 611 ! Some functionals need a filter to be applied on sigma (density gradient) 612 ! because libXC v6 doesn't implement sigma_threshold 613 if (xc_func%is_hybrid) then 614 do jj=1,n_sigma_filtered 615 if (xc_func%id==libxc_functionals_getid(trim(sigma_filtered(jj)))) then 616 xc_func%sigma_threshold=sigma_threshold_def 617 end if 618 end do 619 end if 620 621 ! Dump functional information 622 call c_f_pointer(xc_get_info_name(xc_func%conf),strg_c) 623 call xc_char_to_f(strg_c,msg);msg=' '//trim(msg) 624 call wrtout(std_out,msg,'COLL') 625 iref_c=0 626 do while (iref_c>=0) 627 call c_f_pointer(xc_get_info_refs(xc_func%conf,iref_c),strg_c) 628 if (associated(strg_c)) then 629 call xc_char_to_f(strg_c,msg);msg=' '//trim(msg) 630 call wrtout(std_out,msg,'COLL') 631 iref_c=iref_c+1 632 else 633 iref_c=-1 634 end if 635 end do 636 637 #else 638 ABI_UNUSED(xc_tb09_c) 639 #endif 640 641 end do 642 643 msg='';call wrtout(std_out,msg,'COLL') 644 645 end subroutine libxc_functionals_init
libxc_functionals/libxc_functionals_is_hybrid [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_is_hybrid
FUNCTION
Test function to identify whether the presently used (set of) functional(s) is hybrid or not
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1345 function libxc_functionals_is_hybrid(xc_functionals) 1346 1347 !Arguments ------------------------------------ 1348 logical :: libxc_functionals_is_hybrid 1349 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 1350 1351 ! ************************************************************************* 1352 1353 libxc_functionals_is_hybrid = .false. 1354 1355 if (present(xc_functionals)) then 1356 libxc_functionals_is_hybrid=(any(xc_functionals%is_hybrid)) 1357 else 1358 libxc_functionals_is_hybrid=(any(xc_global%is_hybrid)) 1359 end if 1360 1361 end function libxc_functionals_is_hybrid
libxc_functionals/libxc_functionals_is_hybrid_from_id [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_is_hybrid_from_id
FUNCTION
Test function to identify whether a functional is hybrid or not, from its id
INPUTS
xcid= id of a LibXC functional
SOURCE
1378 function libxc_functionals_is_hybrid_from_id(xcid) 1379 1380 !Arguments ------------------------------------ 1381 logical :: libxc_functionals_is_hybrid_from_id 1382 integer,intent(in) :: xcid 1383 !Local variables------------------------------- 1384 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1385 integer(C_INT) :: xcid_c 1386 #endif 1387 1388 ! ************************************************************************* 1389 1390 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1391 xcid_c=int(xcid,kind=C_INT) 1392 libxc_functionals_is_hybrid_from_id =(xc_func_is_hybrid_from_id(xcid_c)==1) 1393 #else 1394 libxc_functionals_is_hybrid_from_id = .false. 1395 if (.false.) write(std_out,*) xcid 1396 #endif 1397 1398 end function libxc_functionals_is_hybrid_from_id
libxc_functionals/libxc_functionals_is_tb09 [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_is_tb09
FUNCTION
Test function to identify whether the presently used functional is Tran-Blaha 2009 or not
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1036 logical function libxc_functionals_is_tb09(xc_functionals) result(ans) 1037 1038 !Arguments ------------------------------------ 1039 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 1040 1041 ! ************************************************************************* 1042 1043 ans = .false. 1044 1045 if (present(xc_functionals)) then 1046 ans = any(xc_functionals%id == libxc_functionals_getid('XC_MGGA_X_TB09')) 1047 else 1048 ans = any(xc_global%id == libxc_functionals_getid('XC_MGGA_X_TB09')) 1049 end if 1050 1051 end function libxc_functionals_is_tb09
libxc_functionals/libxc_functionals_isgga [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_isgga
FUNCTION
Test function to identify whether the presently used (set of) functional(s) is a GGA or not
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
960 function libxc_functionals_isgga(xc_functionals) 961 962 !Arguments ------------------------------------ 963 logical :: libxc_functionals_isgga 964 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 965 966 ! ************************************************************************* 967 968 libxc_functionals_isgga = .false. 969 if (.not.libxc_constants_initialized) call libxc_functionals_constants_load() 970 971 if (present(xc_functionals)) then 972 libxc_functionals_isgga=(any(xc_functionals%family==XC_FAMILY_GGA) .or. & 973 & any(xc_functionals%family==XC_FAMILY_HYB_GGA)) 974 else 975 libxc_functionals_isgga=(any(xc_global%family==XC_FAMILY_GGA) .or. & 976 & any(xc_global%family==XC_FAMILY_HYB_GGA)) 977 end if 978 979 end function libxc_functionals_isgga
libxc_functionals/libxc_functionals_islda [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_islda
FUNCTION
Test function to identify whether the presently used (set of) functional(s) is a LDA or not
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
922 function libxc_functionals_islda(xc_functionals) 923 924 !Arguments ------------------------------------ 925 logical :: libxc_functionals_islda 926 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 927 928 ! ************************************************************************* 929 930 libxc_functionals_islda = .false. 931 if (.not.libxc_constants_initialized) call libxc_functionals_constants_load() 932 933 if (present(xc_functionals)) then 934 libxc_functionals_islda=(any(xc_functionals%family==XC_FAMILY_LDA) .or. & 935 & any(xc_functionals%family==XC_FAMILY_HYB_LDA)) 936 else 937 libxc_functionals_islda=(any(xc_global%family==XC_FAMILY_LDA) .or. & 938 & any(xc_global%family==XC_FAMILY_HYB_LDA)) 939 end if 940 941 end function libxc_functionals_islda
libxc_functionals/libxc_functionals_ismgga [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_ismgga
FUNCTION
Test function to identify whether the presently used (set of) functional(s) is a Meta-GGA or not
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
998 function libxc_functionals_ismgga(xc_functionals) 999 1000 !Arguments ------------------------------------ 1001 logical :: libxc_functionals_ismgga 1002 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 1003 1004 ! ************************************************************************* 1005 1006 libxc_functionals_ismgga = .false. 1007 if (.not.libxc_constants_initialized) call libxc_functionals_constants_load() 1008 1009 if (present(xc_functionals)) then 1010 libxc_functionals_ismgga=(any(xc_functionals%family==XC_FAMILY_MGGA) .or. & 1011 & any(xc_functionals%family==XC_FAMILY_HYB_MGGA)) 1012 else 1013 libxc_functionals_ismgga=(any(xc_global%family==XC_FAMILY_MGGA) .or. & 1014 & any(xc_global%family==XC_FAMILY_HYB_MGGA)) 1015 end if 1016 1017 end function libxc_functionals_ismgga
libxc_functionals/libxc_functionals_ixc [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_ixc
FUNCTION
Return the value of ixc used to initialize the XC structure
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
889 function libxc_functionals_ixc(xc_functionals) 890 891 !Arguments ------------------------------------ 892 integer :: libxc_functionals_ixc 893 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 894 895 ! ************************************************************************* 896 897 if (present(xc_functionals)) then 898 libxc_functionals_ixc=xc_functionals(1)%abi_ixc 899 else 900 libxc_functionals_ixc=xc_global(1)%abi_ixc 901 end if 902 903 end function libxc_functionals_ixc
libxc_functionals/libxc_functionals_needs_laplacian [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_needs_laplacian
FUNCTION
Test function to identify whether the presently used (set of) functional(s) needs the laplacian of the density or not
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1113 function libxc_functionals_needs_laplacian(xc_functionals) 1114 1115 !Arguments ------------------------------------ 1116 implicit none 1117 logical :: libxc_functionals_needs_laplacian 1118 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 1119 1120 ! ************************************************************************* 1121 1122 libxc_functionals_needs_laplacian = .false. 1123 1124 if (present(xc_functionals)) then 1125 libxc_functionals_needs_laplacian=(any(xc_functionals%needs_laplacian)) 1126 else 1127 libxc_functionals_needs_laplacian=(any(xc_global%needs_laplacian)) 1128 end if 1129 1130 end function libxc_functionals_needs_laplacian
libxc_functionals/libxc_functionals_needs_temperature [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_needs_temperature
FUNCTION
Test function to identify whether the presently used (set of) functional(s) needs the electronic temperature or not
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1149 function libxc_functionals_needs_temperature(xc_functionals) 1150 1151 !Arguments ------------------------------------ 1152 implicit none 1153 logical :: libxc_functionals_needs_temperature 1154 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 1155 1156 ! ************************************************************************* 1157 1158 libxc_functionals_needs_temperature = .false. 1159 1160 if (present(xc_functionals)) then 1161 libxc_functionals_needs_temperature=(any(xc_functionals%temperature>tol8)) 1162 else 1163 libxc_functionals_needs_temperature=(any(xc_global%temperature>tol8)) 1164 end if 1165 1166 end function libxc_functionals_needs_temperature
libxc_functionals/libxc_functionals_nspin [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_nspin
FUNCTION
Returns the number of spin components for the (set of) XC functional(s)
INPUTS
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1310 function libxc_functionals_nspin(xc_functionals) 1311 1312 !Arguments ------------------------------------ 1313 integer :: libxc_functionals_nspin 1314 type(libxc_functional_type),intent(in),optional :: xc_functionals(2) 1315 1316 ! ************************************************************************* 1317 1318 libxc_functionals_nspin = 1 1319 1320 if (present(xc_functionals)) then 1321 if (any(xc_functionals%nspin==2)) libxc_functionals_nspin=2 1322 else 1323 if (any(xc_global%nspin==2)) libxc_functionals_nspin=2 1324 end if 1325 1326 end function libxc_functionals_nspin
libxc_functionals/libxc_functionals_set_c_tb09 [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_set_c_tb09
FUNCTION
Set c parameter for the Tran-Blaha 2009 functional
INPUTS
xc_c_tb09= value of the c parameter to set for the TB09 functional
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
SOURCE
1070 subroutine libxc_functionals_set_c_tb09(xc_tb09_c,xc_functionals) 1071 1072 !Arguments ------------------------------------ 1073 real(dp),intent(in) :: xc_tb09_c 1074 type(libxc_functional_type),intent(inout),optional :: xc_functionals(2) 1075 !Local variables ------------------------------- 1076 integer :: ii 1077 1078 ! ************************************************************************* 1079 1080 if (present(xc_functionals)) then 1081 do ii=1,2 1082 if (xc_functionals(ii)%id == libxc_functionals_getid('XC_MGGA_X_TB09')) then 1083 xc_functionals(ii)%xc_tb09_c = xc_tb09_c 1084 end if 1085 end do 1086 else 1087 do ii=1,2 1088 if (xc_global(ii)%id == libxc_functionals_getid('XC_MGGA_X_TB09')) then 1089 xc_global(ii)%xc_tb09_c = xc_tb09_c 1090 end if 1091 end do 1092 end if 1093 1094 end subroutine libxc_functionals_set_c_tb09
libxc_functionals/libxc_functionals_set_hybridparams [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_set_hybridparams
FUNCTION
Set the parameters of an hybrid functional (mixing coefficient(s) and range separation) Applies on a (set of) functional(s)
INPUTS
[hyb_mixing] = mixing factor of Fock contribution [hyb_mixing_sr] = mixing factor of short-range Fock contribution [hyb_range] = Range (for separation) [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument Handle for XC functionals
OUTPUT
SOURCE
1509 subroutine libxc_functionals_set_hybridparams(hyb_mixing,hyb_mixing_sr,hyb_range,xc_functionals) 1510 1511 !Arguments ------------------------------------ 1512 real(dp),intent(in),optional :: hyb_mixing,hyb_mixing_sr,hyb_range 1513 type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2) 1514 !Local variables ------------------------------- 1515 integer :: ii,id_pbe0,id_hse03,id_hse06 1516 logical :: is_pbe0,is_hse 1517 integer :: func_id(2) 1518 character(len=500) :: msg 1519 type(libxc_functional_type),pointer :: xc_func 1520 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1521 integer(C_INT) :: npar_c 1522 real(C_DOUBLE) :: alpha_c,beta_c,omega_c,param_c(3) 1523 #endif 1524 1525 ! ************************************************************************* 1526 1527 is_pbe0=.false. 1528 is_hse =.false. 1529 id_pbe0=libxc_functionals_getid('HYB_GGA_XC_PBEH') 1530 id_hse03=libxc_functionals_getid('HYB_GGA_XC_HSE03') 1531 id_hse06=libxc_functionals_getid('HYB_GGA_XC_HSE06') 1532 1533 do ii = 1, 2 1534 1535 ! Select XC functional 1536 if (present(xc_functionals)) then 1537 xc_func => xc_functionals(ii) 1538 else 1539 xc_func => xc_global(ii) 1540 end if 1541 func_id(ii)=xc_func%id 1542 1543 ! Doesnt work with all hybrid functionals 1544 if (is_pbe0.or.is_hse) then 1545 msg='Invalid XC functional: contains 2 hybrid exchange functionals!' 1546 ABI_ERROR(msg) 1547 end if 1548 is_pbe0=(xc_func%id==id_pbe0) 1549 is_hse=((xc_func%id==id_hse03).or.(xc_func%id==id_hse06)) 1550 if ((.not.is_pbe0).and.(.not.is_hse)) cycle 1551 1552 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 1553 ! New values for parameters 1554 1555 ! PBE0 type functionals 1556 if (present(hyb_mixing))then 1557 xc_func%hyb_mixing=hyb_mixing 1558 alpha_c=real(xc_func%hyb_mixing,kind=C_DOUBLE) 1559 if (is_pbe0) then 1560 npar_c=int(1,kind=C_INT) ; param_c(1)=alpha_c 1561 call xc_func_set_params(xc_func%conf,param_c,npar_c) 1562 endif 1563 endif 1564 1565 ! HSE type functionals 1566 if(present(hyb_mixing_sr).or.present(hyb_range)) then 1567 if (present(hyb_mixing_sr)) xc_func%hyb_mixing_sr=hyb_mixing_sr 1568 if (present(hyb_range)) xc_func%hyb_range=hyb_range 1569 beta_c =real(xc_func%hyb_mixing_sr,kind=C_DOUBLE) 1570 omega_c=real(xc_func%hyb_range,kind=C_DOUBLE) 1571 if (is_hse) then 1572 npar_c=int(3,kind=C_INT) 1573 param_c(1)=beta_c;param_c(2:3)=omega_c 1574 call xc_func_set_params(xc_func%conf,param_c,npar_c) 1575 endif 1576 end if 1577 1578 #else 1579 ABI_UNUSED(hyb_mixing) 1580 ABI_UNUSED(hyb_mixing_sr) 1581 ABI_UNUSED(hyb_range) 1582 #endif 1583 1584 end do 1585 1586 if ((.not.is_pbe0).and.(.not.is_hse)) then 1587 write(msg,'(3a,2i6,a,a,i6,a,i6,a,i6,a)')'Invalid XC functional: not able to change parameters for this functional !',ch10,& 1588 & 'The IDs are ',func_id(:),ch10,& 1589 & 'Allowed HYB_GGA_XC_PBEH, HYB_GGA_XC_HSE03, and HYB_GGA_XC_HSE06 with IDs =',id_pbe0,',',id_hse03,',',id_hse06,'.' 1590 ABI_ERROR(msg) 1591 end if 1592 1593 end subroutine libxc_functionals_set_hybridparams
libxc_functionals/libxc_functionals_set_temp [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_set_temp
FUNCTION
Set the electronic temperature in a single XC functional
No action if functional doesnt depend on temperature
INPUTS
xc_functional=<type(libxc_functional_type)>, handle for XC functional temperature=electronic temperature (in Ha units, i.e. T_kelvin * k_B_in_Ha/K )
SOURCE
2330 subroutine libxc_functionals_set_temp(xc_functional,temperature) 2331 2332 !Arguments ------------------------------------ 2333 real(dp),intent(in) :: temperature 2334 type(libxc_functional_type),intent(in) :: xc_functional 2335 !Local variables------------------------------- 2336 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2337 integer(C_INT) :: iset_c,npar_c 2338 real(C_DOUBLE) :: temp_c,param_c(1) 2339 character(len=50) :: par_name 2340 character(kind=C_CHAR,len=1),target :: name_c(2) 2341 #endif 2342 2343 ! ************************************************************************* 2344 2345 #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING 2346 if (xc_functional%temperature>zero) then 2347 2348 par_name="T" ; name_c=xc_char_to_c(trim(par_name)) 2349 temp_c=real(temperature,kind=C_DOUBLE) 2350 iset_c = xc_func_set_params_name(xc_functional%conf,c_loc(name_c),temp_c) 2351 if (iset_c /= 0) then 2352 !Try this when set_params_name method is not available (libXC<5) 2353 if (xc_functional%id==libxc_functionals_getid('XC_LDA_XC_KSDT') .or. & 2354 & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_GDSMFB') .or. & 2355 & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_CORRKSDT')) then 2356 param_c(1)=real(zero,kind=C_DOUBLE);npar_c=int(1,kind=C_INT) 2357 call xc_func_set_params(xc_functional%conf,param_c,npar_c) 2358 end if 2359 end if 2360 2361 end if 2362 2363 #else 2364 if (.False.) write(std_out,*) xc_functional%id 2365 #endif 2366 2367 end subroutine libxc_functionals_set_temp
libxc_functionals/libxc_functionals_set_temperature [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
libxc_functionals_set_temperature
FUNCTION
Set the electronic temperature in a (set of) of XC functional(s)
No action when no temperature dependence
INPUTS
temperature=electronic temperature (in Kelvin units)
[xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
Handle for XC functionals
OUTPUT
SOURCE
1188 subroutine libxc_functionals_set_temperature(temperature,xc_functionals) 1189 1190 !Arguments ------------------------------------ 1191 real(dp),intent(in) :: temperature 1192 type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2) 1193 !Local variables ------------------------------- 1194 integer :: ii 1195 type(libxc_functional_type),pointer :: xc_func 1196 1197 ! ************************************************************************* 1198 1199 do ii = 1, 2 1200 1201 ! Select XC functional 1202 if (present(xc_functionals)) then 1203 xc_func => xc_functionals(ii) 1204 else 1205 xc_func => xc_global(ii) 1206 end if 1207 1208 if (xc_func%id>0) then 1209 call libxc_functionals_set_temp(xc_func,temperature) 1210 end if 1211 1212 end do 1213 1214 end subroutine libxc_functionals_set_temperature
libxc_functionals/xc_char_to_c [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
xc_char_to_c
FUNCTION
Helper function to convert a Fortran string to a C string Based on a routine by Joseph M. Krahn
INPUTS
f_string=Fortran string
OUTPUT
c_string=C string
SOURCE
2439 #if defined HAVE_FC_ISO_C_BINDING 2440 function xc_char_to_c(f_string) result(c_string) 2441 2442 !Arguments ------------------------------------ 2443 character(len=*),intent(in) :: f_string 2444 character(kind=C_CHAR,len=1) :: c_string(len_trim(f_string)+1) 2445 !Local variables ------------------------------- 2446 integer :: ii,strlen 2447 2448 !! ************************************************************************* 2449 2450 strlen=len_trim(f_string) 2451 forall(ii=1:strlen) 2452 c_string(ii)=f_string(ii:ii) 2453 end forall 2454 c_string(strlen+1)=C_NULL_CHAR 2455 end function xc_char_to_c 2456 #endif
libxc_functionals/xc_char_to_f [ Functions ]
[ Top ] [ libxc_functionals ] [ Functions ]
NAME
xc_char_to_f
FUNCTION
Helper function to convert a C string to a Fortran string Based on a routine by Joseph M. Krahn
NOTES
non-ascii chars are replaced by "?" as outputting strings containing non-ascii entries can lead to IO error with ifort when running in parallel (don't know why sequential execution is OK, though) forrtl: severe (38): error during write, unit 6, file /proc/3478/fd/1 Image PC Routine Line Source libifcoremt.so.5 00007FEA9BA95F46 for__io_return Unknown Unknown libifcoremt.so.5 00007FEA9BB03A99 for_write_seq_fmt Unknown Unknown libifcoremt.so.5 00007FEA9BB0193A for_write_seq_fmt Unknown Unknown abinit 000000000285EB7A m_io_tools_mp_wri 1218 m_io_tools.F90
INPUTS
c_string=C string
OUTPUT
f_string=Fortran string
SOURCE
2488 #if defined HAVE_FC_ISO_C_BINDING 2489 subroutine xc_char_to_f(c_string,f_string) 2490 2491 !Arguments ------------------------------------ 2492 character(kind=C_CHAR,len=1),intent(in) :: c_string(*) 2493 character(len=*),intent(out) :: f_string 2494 !Local variables ------------------------------- 2495 integer :: ii 2496 2497 !! ************************************************************************* 2498 2499 ii=1 2500 do while(c_string(ii)/=C_NULL_CHAR.and.ii<=len(f_string)) 2501 if (iachar(c_string(ii)) <= 127) then 2502 f_string(ii:ii)=c_string(ii) 2503 else 2504 f_string(ii:ii)="?" 2505 end if 2506 ii=ii+1 2507 end do 2508 if (ii<len(f_string)) f_string(ii:)=' ' 2509 end subroutine xc_char_to_f 2510 #endif