Branch data Line data Source code
1 : : !!****m* ABINIT/libxc_functionals
2 : : !! NAME
3 : : !! libxc_functionals
4 : : !!
5 : : !! FUNCTION
6 : : !! Module containing interfaces to the LibXC library, for exchange
7 : : !! correlation potentials and energies. The interfacing between
8 : : !! the ABINIT and LibXC formats and datastructures happens here.
9 : : !! Also contains basic container datatype for LibXC interfacing.
10 : : !!
11 : : !! COPYRIGHT
12 : : !! Copyright (C) 2008-2026 ABINIT group (MOliveira,LHH,FL,GMR,MT)
13 : : !! This file is distributed under the terms of the
14 : : !! GNU Gener_al Public License, see ~abinit/COPYING
15 : : !! or http://www.gnu.org/copyleft/gpl.txt .
16 : : !!
17 : : !! NOTES
18 : : !! libxc_functionals.F90 defines a structured datatype (libxc_functional_type)
19 : : !! and associated methods to initialize/finalize it and get properties from it.
20 : : !! Abinit used a global variable (xc_global, libxc_functional_type) which is
21 : : !! initialized in the driving routine (driver) with the value of ixc specified
22 : : !! by the user in the input file.
23 : : !! * It is possible to change the value of ixc at run-time; for that we have
24 : : !! to reinitialize the global structure with the new value of ixc before
25 : : !! computing XC quantities. Moreover one has to reinstate the old functional
26 : : !! before returning so that the other routines will continue to used the
27 : : !! previous ixc. This task can be accomplished with the following pseudocode:
28 : : !! !!!!! if (old_ixc<0) call libxc_functionals_end()
29 : : !! !!!!! if (new_ixc<0) call libxc_functionals_init(new_ixc,nspden)
30 : : !! !!!!! >>>> Compute XC stuff here.
31 : : !! !!!!! if (new_ixc<0) call libxc_functionals_end()
32 : : !! !!!!! if (old_ixc<0) call libxc_functionals_init(old_ixc,nspden)
33 : : !! * It is also possible to define a local (private) variable of type libxc_functional_type.
34 : : !! For that, the different methods have to be called with an extra optional
35 : : !! argument (called xc_funcs in this example):
36 : : !! !!!!! call libxc_functionals_init(ixc,nspden,xc_funcs)
37 : : !! !!!!! call libxc_functionals_end(xc_funcs)
38 : : !!
39 : : !! SOURCE
40 : :
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_is_potential_only ! Return TRUE if one of the XC functionals in the set is potential-only
74 : : public :: libxc_functionals_set_c_tb09 ! Set c parameter for Tran-Blaha 2009 functional
75 : : public :: libxc_functionals_needs_tau ! Return TRUE if the set of XC functional(s) uses KINETIC EN. DENSITY
76 : : public :: libxc_functionals_needs_laplacian ! Return TRUE if the set of XC functional(s) uses LAPLACIAN
77 : : public :: libxc_functionals_needs_temperature ! Return TRUE if the set of XC functional(s) uses the elec. temperature
78 : : public :: libxc_functionals_set_temperature ! Set electronic temperature in a set of XC functional(s)
79 : : public :: libxc_functionals_has_kxc ! Return TRUE if Kxc (3rd der) is available for a set of XC functional(s) set
80 : : public :: libxc_functionals_has_k3xc ! Return TRUE if K3xc (4th der) is available for a set of XC functional(s) set
81 : : public :: libxc_functionals_nspin ! The number of spin components for the set of XC functional(s)
82 : : public :: libxc_functionals_is_hybrid ! Return TRUE if a set of XC functional(s) is hybrid
83 : : public :: libxc_functionals_is_hybrid_from_id ! Return TRUE if a XC functional is hybrid, from its id
84 : : public :: libxc_functionals_get_hybridparams ! Retrieve parameter(s) of hybrid functional(s)
85 : : public :: libxc_functionals_set_hybridparams ! Change parameter(s) of hybrid functional(s)
86 : : public :: libxc_functionals_gga_from_hybrid ! Return the id of the XC-GGA used for the hybrid
87 : : public :: libxc_functionals_getvxc ! Return XC potential and energy, from input density
88 : :
89 : : !Private functions
90 : : private :: libxc_functionals_compute_tb09 ! Compute c parameter for Tran-Blaha 2009 functional
91 : : private :: libxc_functionals_getrefs ! Get references of a single XC functional
92 : : private :: libxc_functionals_depends_on_temp ! TRUE if a single functional depends on elec. temperature
93 : : private :: libxc_functionals_set_temp ! Set electronic temperature in a single XC functional
94 : : private :: libxc_functionals_constants_load ! Load libXC constants from C headers
95 : : #ifdef HAVE_FC_ISO_C_BINDING
96 : : private :: xc_char_to_c ! Convert a string from Fortran to C
97 : : private :: xc_char_to_f ! Convert a string from C to Fortran
98 : : #endif
99 : :
100 : : !Public constants (use libxc_functionals_constants_load to init them)
101 : : integer,public,save :: XC_FAMILY_UNKNOWN = -1
102 : : integer,public,save :: XC_FAMILY_LDA = 1
103 : : integer,public,save :: XC_FAMILY_GGA = 2
104 : : integer,public,save :: XC_FAMILY_MGGA = 4
105 : : integer,public,save :: XC_FAMILY_LCA = 8
106 : : integer,public,save :: XC_FAMILY_OEP = 16
107 : : integer,public,save :: XC_FAMILY_HYB_GGA = 32
108 : : integer,public,save :: XC_FAMILY_HYB_MGGA = 64
109 : : integer,public,save :: XC_FAMILY_HYB_LDA =128
110 : : integer,public,save :: XC_FLAGS_HAVE_EXC = 1
111 : : integer,public,save :: XC_FLAGS_HAVE_VXC = 2
112 : : integer,public,save :: XC_FLAGS_HAVE_FXC = 4
113 : : integer,public,save :: XC_FLAGS_HAVE_KXC = 8
114 : : integer,public,save :: XC_FLAGS_HAVE_LXC = 16
115 : : integer,public,save :: XC_FLAGS_NEEDS_LAPLACIAN= 32768
116 : : integer,public,save :: XC_FLAGS_NEEDS_TAU = 65536
117 : : integer,public,save :: XC_FLAGS_ENFORCE_FHC = 131072
118 : : integer,public,save :: XC_EXCHANGE = 0
119 : : integer,public,save :: XC_CORRELATION = 1
120 : : integer,public,save :: XC_EXCHANGE_CORRELATION = 2
121 : : integer,public,save :: XC_KINETIC = 3
122 : : integer,public,save :: XC_SINGLE_PRECISION = 0
123 : : logical,private,save :: libxc_constants_initialized=.false.
124 : :
125 : : !XC functional public type
126 : : type,public :: libxc_functional_type
127 : : integer :: id ! identifier
128 : : integer :: family ! LDA, GGA, etc.
129 : : integer :: kind ! EXCHANGE, CORRELATION, etc.
130 : : integer :: nspin ! # of spin components
131 : : integer :: abi_ixc ! Abinit IXC id for this functional
132 : : logical :: has_exc ! TRUE is exc is available for the functional
133 : : logical :: has_vxc ! TRUE is vxc is available for the functional
134 : : logical :: has_fxc ! TRUE is fxc is available for the functional
135 : : logical :: has_kxc ! TRUE is kxc is available for the functional
136 : : logical :: needs_tau ! TRUE is functional needs kinetic energy density
137 : : logical :: needs_laplacian ! TRUE is functional needs laplacian of density
138 : : logical :: is_hybrid ! TRUE is functional is a hybrid functional
139 : : real(dp) :: hyb_mixing ! Hybrid functional: mixing factor of Fock contribution (default=0)
140 : : real(dp) :: hyb_mixing_sr ! Hybrid functional: mixing factor of SR Fock contribution (default=0)
141 : : real(dp) :: hyb_range ! Range (for separation) for a hybrid functional (default=0)
142 : : real(dp) :: temperature ! Electronic temperature; if <=0, the functional doesnt depend on it
143 : : real(dp) :: xc_tb09_c ! Special TB09 functional parameter
144 : : real(dp) :: sigma_threshold ! Value of a threshold to be applied on density gradient (sigma)
145 : : ! (temporary dur to a libxc bug) - If <0, apply no filter
146 : : #ifdef HAVE_FC_ISO_C_BINDING
147 : : type(C_PTR),pointer :: conf => null() ! C pointer to the functional itself
148 : : #endif
149 : : end type libxc_functional_type
150 : :
151 : : !List of functionals on which a filter has to be applied on sigma (density gradient)
152 : : ! This should be done by libXC via _set_sigma_threshold but this is not (libXC 6)
153 : : ! This threshold has been evaluated from pbeh functional...
154 : : real(dp),parameter :: sigma_threshold_def = 1.0e-25_dp
155 : : integer,parameter :: n_sigma_filtered = 17
156 : : character(len=28) :: sigma_filtered(n_sigma_filtered) = &
157 : : & ['XC_HYB_GGA_XC_HSE03 ','XC_HYB_GGA_XC_HSE06 ','XC_HYB_GGA_XC_HJS_PBE ',&
158 : : & 'XC_HYB_GGA_XC_HJS_PBE_SOL ','XC_HYB_GGA_XC_HJS_B88 ','XC_HYB_GGA_XC_HJS_B97X ',&
159 : : & 'XC_HYB_GGA_XC_LRC_WPBEH ','XC_HYB_GGA_XC_LRC_WPBE ','XC_HYB_GGA_XC_LC_WPBE ',&
160 : : & 'XC_HYB_GGA_XC_HSE12 ','XC_HYB_GGA_XC_HSE12S ','XC_HYB_GGA_XC_HSE_SOL ',&
161 : : & 'XC_HYB_GGA_XC_LC_WPBE_WHS ','XC_HYB_GGA_XC_LC_WPBEH_WHS ','XC_HYB_GGA_XC_LC_WPBE08_WHS ',&
162 : : & 'XC_HYB_GGA_XC_LC_WPBESOL_WHS','XC_HYB_GGA_XC_WHPBE0 ']
163 : :
164 : : !----------------------------------------------------------------------
165 : :
166 : : !Private global XC functional
167 : : type(libxc_functional_type),target,save :: xc_global(2)
168 : :
169 : : !----------------------------------------------------------------------
170 : :
171 : : !Interfaces for C bindings
172 : : #ifdef HAVE_FC_ISO_C_BINDING
173 : : interface
174 : : integer(C_INT) function xc_func_init(xc_func,functional,nspin) bind(C)
175 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
176 : : integer(C_INT),value :: functional,nspin
177 : : type(C_PTR) :: xc_func
178 : : end function xc_func_init
179 : : end interface
180 : : !
181 : : interface
182 : : subroutine xc_func_end(xc_func) bind(C)
183 : : use, intrinsic :: iso_c_binding, only : C_PTR
184 : : type(C_PTR) :: xc_func
185 : : end subroutine xc_func_end
186 : : end interface
187 : : !
188 : : interface
189 : : integer(C_INT) function xc_functional_get_number(name) bind(C)
190 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
191 : : type(C_PTR),value :: name
192 : : end function xc_functional_get_number
193 : : end interface
194 : : !
195 : : interface
196 : : type(C_PTR) function xc_functional_get_name(number) bind(C)
197 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
198 : : integer(C_INT),value :: number
199 : : end function xc_functional_get_name
200 : : end interface
201 : : !
202 : : interface
203 : : integer(C_INT) function xc_family_from_id(id,family,number) bind(C)
204 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
205 : : integer(C_INT),value :: id
206 : : type(C_PTR),value :: family,number
207 : : end function xc_family_from_id
208 : : end interface
209 : : !
210 : : interface
211 : : subroutine xc_hyb_cam_coef(xc_func,omega,alpha,beta) bind(C)
212 : : use, intrinsic :: iso_c_binding, only : C_DOUBLE,C_PTR
213 : : real(C_DOUBLE) :: omega,alpha,beta
214 : : type(C_PTR) :: xc_func
215 : : end subroutine xc_hyb_cam_coef
216 : : end interface
217 : : !
218 : : interface
219 : : subroutine xc_get_lda(xc_func,np,rho,zk,vrho,v2rho2,v3rho3) bind(C)
220 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
221 : : integer(C_INT),value :: np
222 : : type(C_PTR),value :: rho,zk,vrho,v2rho2,v3rho3
223 : : type(C_PTR) :: xc_func
224 : : end subroutine xc_get_lda
225 : : end interface
226 : : !
227 : : interface
228 : : subroutine xc_get_gga(xc_func,np,rho,sigma,zk,vrho,vsigma,v2rho2,v2rhosigma,v2sigma2, &
229 : : & v3rho3,v3rho2sigma,v3rhosigma2,v3sigma3) bind(C)
230 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
231 : : integer(C_INT),value :: np
232 : : type(C_PTR),value :: rho,sigma,zk,vrho,vsigma,v2rho2,v2rhosigma,v2sigma2, &
233 : : & v3rho3,v3rho2sigma,v3rhosigma2,v3sigma3
234 : : type(C_PTR) :: xc_func
235 : : end subroutine xc_get_gga
236 : : end interface
237 : : !
238 : : interface
239 : : subroutine xc_get_mgga(xc_func,np,rho,sigma,lapl,tau,zk,vrho,vsigma,vlapl,vtau, &
240 : : & v2rho2,v2rhosigma,v2rholapl,v2rhotau,v2sigma2,v2sigmalapl, &
241 : : & v2sigmatau,v2lapl2,v2lapltau,v2tau2) bind(C)
242 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
243 : : integer(C_INT),value :: np
244 : : type(C_PTR),value :: rho,sigma,lapl,tau,zk,vrho,vsigma,vlapl,vtau, &
245 : : & v2rho2,v2sigma2,v2lapl2,v2tau2,v2rhosigma,v2rholapl,v2rhotau, &
246 : : & v2sigmalapl,v2sigmatau,v2lapltau
247 : : type(C_PTR) :: xc_func
248 : : end subroutine xc_get_mgga
249 : : end interface
250 : : !
251 : : interface
252 : : subroutine xc_func_set_params(xc_func,params,n_params) bind(C)
253 : : use, intrinsic :: iso_c_binding, only : C_INT,C_DOUBLE,C_PTR
254 : : integer(C_INT),value :: n_params
255 : : real(C_DOUBLE) :: params(*)
256 : : type(C_PTR) :: xc_func
257 : : end subroutine xc_func_set_params
258 : : end interface
259 : : !
260 : : interface
261 : : integer(C_INT) function xc_func_set_params_name(xc_func,name,param) bind(C)
262 : : use, intrinsic :: iso_c_binding, only : C_INT,C_DOUBLE,C_PTR
263 : : real(C_DOUBLE) :: param
264 : : type(C_PTR) :: xc_func
265 : : type(C_PTR),value :: name
266 : : end function xc_func_set_params_name
267 : : end interface
268 : : !
269 : : interface
270 : : type(C_PTR) function xc_func_get_params_name(xc_func,ipar) bind(C)
271 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
272 : : type(C_PTR) :: xc_func
273 : : integer(C_INT) :: ipar
274 : : end function xc_func_get_params_name
275 : : end interface
276 : : !
277 : : interface
278 : : type(C_PTR) function xc_func_get_params_description(xc_func,ipar) bind(C)
279 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
280 : : type(C_PTR) :: xc_func
281 : : integer(C_INT) :: ipar
282 : : end function xc_func_get_params_description
283 : : end interface
284 : : !
285 : : interface
286 : : subroutine xc_func_set_density_threshold(xc_func,dens_threshold) bind(C)
287 : : use, intrinsic :: iso_c_binding, only : C_DOUBLE,C_PTR
288 : : real(C_DOUBLE) :: dens_threshold
289 : : type(C_PTR) :: xc_func
290 : : end subroutine xc_func_set_density_threshold
291 : : end interface
292 : : !
293 : : interface
294 : : subroutine xc_func_set_sig_threshold(xc_func,sigma_threshold) bind(C)
295 : : use, intrinsic :: iso_c_binding, only : C_DOUBLE,C_PTR
296 : : real(C_DOUBLE) :: sigma_threshold
297 : : type(C_PTR) :: xc_func
298 : : end subroutine xc_func_set_sig_threshold
299 : : end interface
300 : : !
301 : : interface
302 : : subroutine xc_func_set_enforce_fhc(xc_func,on_off) bind(C)
303 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
304 : : type(C_PTR) :: xc_func
305 : : integer(C_INT) :: on_off
306 : : end subroutine xc_func_set_enforce_fhc
307 : : end interface
308 : : !
309 : : interface
310 : : integer(C_INT) function xc_func_is_hybrid_from_id(func_id) bind(C)
311 : : use, intrinsic :: iso_c_binding, only : C_INT
312 : : integer(C_INT),value :: func_id
313 : : end function xc_func_is_hybrid_from_id
314 : : end interface
315 : : !
316 : : interface
317 : : subroutine xc_get_singleprecision_constant(xc_cst_singleprecision) bind(C)
318 : : use, intrinsic :: iso_c_binding, only : C_INT
319 : : integer(C_INT) :: xc_cst_singleprecision
320 : : end subroutine xc_get_singleprecision_constant
321 : : end interface
322 : : !
323 : : interface
324 : : subroutine xc_get_family_constants(xc_cst_unknown,xc_cst_lda,xc_cst_gga,xc_cst_mgga, &
325 : : & xc_cst_lca,xc_cst_oep,xc_cst_hyb_gga, &
326 : : & xc_cst_hyb_mgga,xc_cst_hyb_lda) bind(C)
327 : : use, intrinsic :: iso_c_binding, only : C_INT
328 : : integer(C_INT) :: xc_cst_unknown,xc_cst_lda,xc_cst_gga,xc_cst_mgga, &
329 : : & xc_cst_lca,xc_cst_oep,xc_cst_hyb_gga,xc_cst_hyb_mgga, &
330 : : & xc_cst_hyb_lda
331 : : end subroutine xc_get_family_constants
332 : : end interface
333 : : !
334 : : interface
335 : : subroutine xc_get_flags_constants(xc_cst_flags_have_exc,xc_cst_flags_have_vxc, &
336 : : xc_cst_flags_have_fxc,xc_cst_flags_have_kxc,xc_cst_flags_have_lxc,&
337 : : & xc_cxt_flags_needs_tau,xc_cxt_flags_needs_lapl,xc_cxt_flags_enforce_fhc) bind(C)
338 : : use, intrinsic :: iso_c_binding, only : C_INT
339 : : integer(C_INT) :: xc_cst_flags_have_exc,xc_cst_flags_have_vxc,xc_cst_flags_have_fxc, &
340 : : & xc_cst_flags_have_kxc,xc_cst_flags_have_lxc, &
341 : : & xc_cxt_flags_needs_tau,xc_cxt_flags_needs_lapl,xc_cxt_flags_enforce_fhc
342 : : end subroutine xc_get_flags_constants
343 : : end interface
344 : : !
345 : : interface
346 : : subroutine xc_get_kind_constants(xc_cst_exchange,xc_cst_correlation, &
347 : : & xc_cst_exchange_correlation,xc_cst_kinetic) bind(C)
348 : : use, intrinsic :: iso_c_binding, only : C_INT
349 : : integer(C_INT) :: xc_cst_exchange,xc_cst_correlation, &
350 : : & xc_cst_exchange_correlation,xc_cst_kinetic
351 : : end subroutine xc_get_kind_constants
352 : : end interface
353 : : !
354 : : interface
355 : : type(C_PTR) function xc_func_type_malloc() bind(C)
356 : : use, intrinsic :: iso_c_binding, only : C_PTR
357 : : end function xc_func_type_malloc
358 : : end interface
359 : : !
360 : : interface
361 : : subroutine xc_func_type_free(xc_func) bind(C)
362 : : use, intrinsic :: iso_c_binding, only : C_PTR
363 : : type(C_PTR) :: xc_func
364 : : end subroutine xc_func_type_free
365 : : end interface
366 : : !
367 : : interface
368 : : type(C_PTR) function xc_get_info_name(xc_func) bind(C)
369 : : use, intrinsic :: iso_c_binding, only : C_PTR
370 : : type(C_PTR) :: xc_func
371 : : end function xc_get_info_name
372 : : end interface
373 : : !
374 : : interface
375 : : type(C_PTR) function xc_get_info_refs(xc_func,iref) bind(C)
376 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
377 : : type(C_PTR) :: xc_func
378 : : integer(C_INT) :: iref
379 : : end function xc_get_info_refs
380 : : end interface
381 : : !
382 : : interface
383 : : integer(C_INT) function xc_get_info_flags(xc_func) bind(C)
384 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
385 : : type(C_PTR) :: xc_func
386 : : end function xc_get_info_flags
387 : : end interface
388 : : !
389 : : interface
390 : : integer(C_INT) function xc_get_info_kind(xc_func) bind(C)
391 : : use, intrinsic :: iso_c_binding, only : C_INT,C_PTR
392 : : type(C_PTR) :: xc_func
393 : : end function xc_get_info_kind
394 : : end interface
395 : : #endif
396 : :
397 : : contains
398 : : !!***
399 : :
400 : : !----------------------------------------------------------------------
401 : :
402 : : !!****f* libxc_functionals/libxc_functionals_check
403 : : !! NAME
404 : : !! libxc_functionals_check
405 : : !!
406 : : !! FUNCTION
407 : : !! Check if the code has been compiled with libXC
408 : : !!
409 : : !! INPUTS
410 : : !! [stop_if_error]=optional flag; if TRUE the code stops if libXC is not correctly used
411 : : !!
412 : : !! SOURCE
413 : :
414 : 388152 : function libxc_functionals_check(stop_if_error)
415 : :
416 : : !Arguments ------------------------------------
417 : : logical :: libxc_functionals_check
418 : : logical,intent(in),optional :: stop_if_error
419 : : !Local variables-------------------------------
420 : : character(len=100) :: msg
421 : :
422 : : ! *************************************************************************
423 : :
424 : 388152 : libxc_functionals_check=.true. ; msg=""
425 : :
426 : : #if defined HAVE_LIBXC
427 : : #if defined HAVE_FC_ISO_C_BINDING
428 [ + + ]: 388152 : if (.not.libxc_constants_initialized) call libxc_functionals_constants_load()
429 [ - + ]: 388152 : if (XC_SINGLE_PRECISION==1) then
430 : 0 : libxc_functionals_check=.false.
431 : 0 : msg='LibXC should be compiled with double precision!'
432 : : end if
433 : : #else
434 : : libxc_functionals_check=.false.
435 : : msg='LibXC cannot be used without ISO_C_BINDING support by the Fortran compiler!'
436 : : #endif
437 : : #else
438 : : libxc_functionals_check=.false.
439 : : msg='ABINIT was not compiled with LibXC support.'
440 : : #endif
441 : :
442 [ + + ]: 388152 : if (present(stop_if_error)) then
443 [ + - - + ]: 388134 : if (stop_if_error.and.trim(msg)/="") then
444 : 0 : ABI_ERROR(msg)
445 : : end if
446 : : end if
447 : :
448 : 388152 : end function libxc_functionals_check
449 : : !!***
450 : :
451 : : !----------------------------------------------------------------------
452 : :
453 : : !!****f* libxc_functionals/libxc_functionals_init
454 : : !! NAME
455 : : !! libxc_functionals_init
456 : : !!
457 : : !! FUNCTION
458 : : !! Initialize the desired (set of) XC functional(s), from LibXC.
459 : : !! * Call the LibXC initializer
460 : : !! * Fill preliminary fields in module structures.
461 : : !!
462 : : !! INPUTS
463 : : !! ixc=XC code for Abinit
464 : : !! nspden=number of spin-density components
465 : : !! [enforce_fhc]=flags controlling the enforcement of Fermi Hole Curvature (mGGA only)
466 : : !! [el_temp]=electronic temperature (optional, only for specific functionals)
467 : : !! [xc_tb09_c]=special argument for the Tran-Blaha 2009 functional
468 : : !!
469 : : !! OUTPUT
470 : : !!
471 : : !! SIDE EFFECTS
472 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
473 : : !! Handle for XC functionals
474 : : !!
475 : : !! SOURCE
476 : :
477 : 3949 : subroutine libxc_functionals_init(ixc,nspden,xc_functionals,&
478 : : & enforce_fhc,el_temp,xc_tb09_c) ! optional arguments
479 : :
480 : : !Arguments ------------------------------------
481 : : integer, intent(in) :: nspden
482 : : integer, intent(in) :: ixc
483 : : logical,intent(in),optional :: enforce_fhc
484 : : real(dp),intent(in),optional :: el_temp,xc_tb09_c
485 : : type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2)
486 : : !Local variables-------------------------------
487 : : integer :: ii,jj,nspden_eff
488 : : character(len=500) :: msg
489 : : type(libxc_functional_type),pointer :: xc_func
490 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
491 : : integer :: flags
492 : : integer(C_INT) :: fhc_c,func_id_c,iref_c,npar_c,nspin_c,success_c
493 : : real(C_DOUBLE) :: alpha_c,beta_c,omega_c,param_c(1)
494 : : character(kind=C_CHAR,len=1),pointer :: strg_c
495 : : type(C_PTR) :: func_ptr_c
496 : : #endif
497 : :
498 : : ! *************************************************************************
499 : :
500 : : !Check libXC
501 [ - + ]: 3949 : if (.not.libxc_functionals_check(stop_if_error=.true.)) return
502 [ - + ]: 3949 : if (.not.libxc_constants_initialized)then
503 : 0 : call libxc_functionals_constants_load()
504 : : endif
505 : :
506 : 3949 : nspden_eff=min(nspden,2)
507 : :
508 : : !Select XC functional(s) identifiers
509 [ + + ]: 3949 : if (present(xc_functionals)) then
510 : 2753 : xc_functionals(1)%id = -ixc/1000
511 : 2753 : xc_functionals(2)%id = -ixc + (ixc/1000)*1000
512 : : else
513 : 1196 : xc_global(1)%id = -ixc/1000
514 : 1196 : xc_global(2)%id = -ixc + (ixc/1000)*1000
515 : : end if
516 : :
517 [ + + ]: 11847 : do ii = 1,2
518 : :
519 : : ! Select XC functional
520 [ + + ]: 7898 : if (present(xc_functionals)) then
521 : 5506 : xc_func => xc_functionals(ii)
522 : : else
523 : 2392 : xc_func => xc_global(ii)
524 : : end if
525 : :
526 : 7898 : xc_func%abi_ixc=ixc !Save abinit value for reference
527 : :
528 : 7898 : xc_func%family=XC_FAMILY_UNKNOWN
529 : 7898 : xc_func%kind=-1
530 : 7898 : xc_func%nspin=nspden_eff
531 : 7898 : xc_func%has_exc=.false.
532 : 7898 : xc_func%has_vxc=.false.
533 : 7898 : xc_func%has_fxc=.false.
534 : 7898 : xc_func%has_kxc=.false.
535 : 7898 : xc_func%needs_tau=.false.
536 : 7898 : xc_func%needs_laplacian=.false.
537 : 7898 : xc_func%is_hybrid=.false.
538 : 7898 : xc_func%hyb_mixing=zero
539 : 7898 : xc_func%hyb_mixing_sr=zero
540 : 7898 : xc_func%hyb_range=zero
541 : 7898 : xc_func%temperature=-one
542 : 7898 : xc_func%xc_tb09_c=99.99_dp
543 : 7898 : xc_func%sigma_threshold=-one
544 : :
545 [ + + ]: 7898 : if (xc_func%id<=0) cycle
546 : :
547 : : ! Get XC functional family
548 : 15076 : xc_func%family=libxc_functionals_family_from_id(xc_func%id)
549 : : if (xc_func%family/=XC_FAMILY_LDA .and. &
550 : : & xc_func%family/=XC_FAMILY_GGA .and. &
551 [ + + + + : 4468 : & xc_func%family/=XC_FAMILY_MGGA.and. &
- + ]
552 : : & xc_func%family/=XC_FAMILY_HYB_GGA) then
553 : : write(msg, '(a,i8,2a,i8,a,i8,3a,i8,6a)' )&
554 : 0 : & 'Invalid IXC = ',ixc,ch10,&
555 : 0 : & 'Current xc_func%id=',xc_func%id,', (ii=',ii,')',ch10,&
556 : 0 : & 'The associated LibXC functional family ',xc_func%family,&
557 : 0 : & ' is currently unsupported by ABINIT',ch10,&
558 : 0 : & '(-1 means the family is unknown to the LibXC itself)',ch10,&
559 : 0 : & 'Please consult the LibXC documentation',ch10
560 : 0 : ABI_ERROR(msg)
561 : : end if
562 : :
563 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
564 : :
565 : : ! Allocate functional
566 : 7538 : func_ptr_c=xc_func_type_malloc()
567 : 7538 : call c_f_pointer(func_ptr_c,xc_func%conf)
568 : :
569 : : ! Initialize functional
570 : 7538 : func_id_c=int(xc_func%id,kind=C_INT)
571 : 7538 : nspin_c=int(nspden_eff,kind=C_INT)
572 : 7538 : success_c=xc_func_init(xc_func%conf,func_id_c,nspin_c)
573 [ - + ]: 7538 : if (success_c/=0) then
574 : 0 : msg='Error in libXC functional initialization!'
575 : 0 : ABI_ERROR(msg)
576 : : end if
577 : :
578 : : ! Special treatment for LDA_C_XALPHA functional
579 [ + + ]: 7538 : if (xc_func%id==libxc_functionals_getid('XC_LDA_C_XALPHA')) then
580 : 6 : param_c(1)=real(zero,kind=C_DOUBLE);npar_c=int(1,kind=C_INT)
581 : 6 : call xc_func_set_params(xc_func%conf,param_c,npar_c)
582 : : end if
583 : :
584 : : ! Special treatment for XC_MGGA_X_TB09 functional
585 [ + + ]: 7538 : if (xc_func%id==libxc_functionals_getid('XC_MGGA_X_TB09')) then
586 [ - + ]: 30 : if (.not.present(xc_tb09_c)) then
587 : 0 : msg='xc_tb09_c argument is mandatory for TB09 functional!'
588 : 0 : ABI_BUG(msg)
589 : : end if
590 : 30 : xc_func%xc_tb09_c=xc_tb09_c
591 : : end if
592 : :
593 : : ! Get functional kind
594 : 7538 : xc_func%kind=int(xc_get_info_kind(xc_func%conf))
595 : :
596 : : ! Get functional flags
597 : 7538 : flags=int(xc_get_info_flags(xc_func%conf))
598 : 7538 : xc_func%has_exc=(iand(flags,XC_FLAGS_HAVE_EXC)>0)
599 : 7538 : xc_func%has_vxc=(iand(flags,XC_FLAGS_HAVE_VXC)>0)
600 : 7538 : xc_func%has_fxc=(iand(flags,XC_FLAGS_HAVE_FXC)>0)
601 : 7538 : xc_func%has_kxc=(iand(flags,XC_FLAGS_HAVE_KXC)>0)
602 : :
603 : : ! Retrieve/set parameters for metaGGA functionals
604 [ + + - + ]: 7538 : if (xc_func%family==XC_FAMILY_MGGA.or. &
605 : : & xc_func%family==XC_FAMILY_HYB_MGGA) then
606 : 255 : xc_func%needs_tau=.true.;xc_func%needs_laplacian=.false.
607 [ + - ]: 255 : if (XC_FLAGS_NEEDS_TAU>0) xc_func%needs_tau=(iand(flags,XC_FLAGS_NEEDS_TAU)>0)
608 [ + - ]: 255 : if (XC_FLAGS_NEEDS_LAPLACIAN>0) xc_func%needs_laplacian=(iand(flags,XC_FLAGS_NEEDS_LAPLACIAN)>0)
609 [ - + - - ]: 255 : fhc_c=int(0,kind=C_INT) ; if (present(enforce_fhc)) fhc_c=merge(int(1,kind=C_INT),int(0,kind=C_INT),enforce_fhc)
610 : 255 : call xc_func_set_enforce_fhc(xc_func%conf,fhc_c)
611 : : end if
612 : :
613 : : ! Retrieve parameters for hybrid functionals
614 : 7538 : xc_func%is_hybrid=(xc_func_is_hybrid_from_id(xc_func%id)==1)
615 [ + + ]: 7538 : if (xc_func%is_hybrid) then
616 : 174 : call xc_hyb_cam_coef(xc_func%conf,omega_c,alpha_c,beta_c)
617 : 174 : xc_func%hyb_mixing=real(alpha_c,kind=dp)
618 : 174 : xc_func%hyb_mixing_sr=real(beta_c,kind=dp)
619 : 174 : xc_func%hyb_range=real(omega_c,kind=dp)
620 : : end if
621 : :
622 : : ! Possible temperature dependence
623 [ + + ]: 7538 : if (present(el_temp)) then
624 [ + + ]: 2300 : if (el_temp>tol10) then
625 [ + + ]: 2296 : if (libxc_functionals_depends_on_temp(xc_func)) then
626 : 7 : xc_func%temperature=el_temp
627 : 7 : call libxc_functionals_set_temp(xc_func,el_temp)
628 : : end if
629 : : end if
630 : : end if
631 : :
632 : : ! Some functionals need a filter to be applied on sigma (density gradient)
633 : : ! because libXC v6 doesn't implement sigma_threshold
634 [ + + ]: 7538 : if (xc_func%is_hybrid) then
635 [ + + ]: 3132 : do jj=1,n_sigma_filtered
636 [ + - + + ]: 3132 : if (xc_func%id==libxc_functionals_getid(trim(sigma_filtered(jj)))) then
637 : 131 : xc_func%sigma_threshold=sigma_threshold_def
638 : : end if
639 : : end do
640 : : end if
641 : :
642 : : ! Dump functional information
643 : 7538 : call c_f_pointer(xc_get_info_name(xc_func%conf),strg_c)
644 : 7538 : call xc_char_to_f(strg_c,msg);msg=' '//trim(msg)
645 : 7538 : call wrtout(std_out,msg,'COLL')
646 : 7538 : iref_c=0
647 [ + + ]: 32089 : do while (iref_c>=0)
648 : 20602 : call c_f_pointer(xc_get_info_refs(xc_func%conf,iref_c),strg_c)
649 [ + + ]: 28500 : if (associated(strg_c)) then
650 : 13064 : call xc_char_to_f(strg_c,msg);msg=' '//trim(msg)
651 : 13064 : call wrtout(std_out,msg,'COLL')
652 : 13064 : iref_c=iref_c+1
653 : : else
654 : 7538 : iref_c=-1
655 : : end if
656 : : end do
657 : :
658 : : #else
659 : : ABI_UNUSED(xc_tb09_c)
660 : : #endif
661 : :
662 : : end do
663 : :
664 : 3949 : msg='';call wrtout(std_out,msg,'COLL')
665 : :
666 : : end subroutine libxc_functionals_init
667 : : !!***
668 : :
669 : : !----------------------------------------------------------------------
670 : :
671 : : !!****f* libxc_functionals/libxc_functionals_end
672 : : !! NAME
673 : : !! libxc_functionals_end
674 : : !!
675 : : !! FUNCTION
676 : : !! End usage of a (set of) XC functional(s).
677 : : !! Call LibXC end function and deallocate module contents.
678 : : !!
679 : : !! INPUTS
680 : : !!
681 : : !! OUTPUT
682 : : !!
683 : : !! SIDE EFFECTS
684 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
685 : : !! Handle for XC functionals
686 : : !!
687 : : !! SOURCE
688 : :
689 : 3946 : subroutine libxc_functionals_end(xc_functionals)
690 : :
691 : : !Arguments ------------------------------------
692 : : type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2)
693 : : !Local variables-------------------------------
694 : : integer :: ii
695 : : type(libxc_functional_type),pointer :: xc_func
696 : :
697 : : ! *************************************************************************
698 : :
699 [ + + ]: 11838 : do ii = 1,2
700 : :
701 : : ! Select XC functional
702 [ + + ]: 7892 : if (present(xc_functionals)) then
703 : 5502 : xc_func => xc_functionals(ii)
704 : : else
705 : 2390 : xc_func => xc_global(ii)
706 : : end if
707 : :
708 [ + + ]: 7892 : if (xc_func%id <= 0) cycle
709 : 7532 : xc_func%id=-1
710 : 7532 : xc_func%family=-1
711 : 7532 : xc_func%kind=-1
712 : 7532 : xc_func%nspin=1
713 : 7532 : xc_func%abi_ixc=huge(0)
714 : 7532 : xc_func%has_exc=.false.
715 : 7532 : xc_func%has_vxc=.false.
716 : 7532 : xc_func%has_fxc=.false.
717 : 7532 : xc_func%has_kxc=.false.
718 : 7532 : xc_func%needs_tau=.false.
719 : 7532 : xc_func%needs_laplacian=.false.
720 : 7532 : xc_func%is_hybrid=.false.
721 : 7532 : xc_func%hyb_mixing=zero
722 : 7532 : xc_func%hyb_mixing_sr=zero
723 : 7532 : xc_func%hyb_range=zero
724 : 7532 : xc_func%temperature=-one
725 : 7532 : xc_func%xc_tb09_c=99.99_dp
726 : 7532 : xc_func%sigma_threshold=-one
727 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
728 [ + - ]: 11478 : if (associated(xc_func%conf)) then
729 : 7532 : call xc_func_end(xc_func%conf)
730 : 7532 : call xc_func_type_free(c_loc(xc_func%conf))
731 : : end if
732 : : #endif
733 : :
734 : : end do
735 : :
736 : 3946 : end subroutine libxc_functionals_end
737 : : !!***
738 : :
739 : : !----------------------------------------------------------------------
740 : :
741 : : !!****f* libxc_functionals/libxc_functionals_fullname
742 : : !! NAME
743 : : !! libxc_functionals_fullname
744 : : !!
745 : : !! FUNCTION
746 : : !! Return full name of a (set of) XC functional(s)
747 : : !!
748 : : !! INPUTS
749 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
750 : : !! Handle for XC functionals
751 : : !!
752 : : !! OUTPUT
753 : : !!
754 : : !! SOURCE
755 : :
756 : 0 : function libxc_functionals_fullname(xc_functionals)
757 : :
758 : : !Arguments ------------------------------------
759 : : character(len=100) :: libxc_functionals_fullname
760 : : type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2)
761 : : !Local variables-------------------------------
762 : : integer :: nxc
763 : 0 : type(libxc_functional_type),pointer :: xc_funcs(:)
764 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
765 : : character(len=100) :: xcname
766 : : character(kind=C_CHAR,len=1),pointer :: strg_c
767 : : #endif
768 : :
769 : : ! *************************************************************************
770 : :
771 : 0 : libxc_functionals_fullname='No XC functional'
772 : :
773 : 0 : if (present(xc_functionals)) then
774 : 0 : xc_funcs => xc_functionals
775 : : else
776 : 0 : xc_funcs => xc_global
777 : : end if
778 : :
779 : 0 : nxc=size(xc_funcs)
780 : : if (nxc<1) return
781 : :
782 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
783 : : if (nxc<2) then
784 : : if (xc_funcs(1)%id /= 0) then
785 : : call c_f_pointer(xc_functional_get_name(xc_funcs(1)%id),strg_c)
786 : : call xc_char_to_f(strg_c,libxc_functionals_fullname)
787 : : end if
788 [ # # ]: 0 : else if (xc_funcs(1)%id <= 0) then
789 [ # # ]: 0 : if (xc_funcs(2)%id /= 0) then
790 : 0 : call c_f_pointer(xc_functional_get_name(xc_funcs(2)%id),strg_c)
791 : 0 : call xc_char_to_f(strg_c,libxc_functionals_fullname)
792 : : end if
793 [ # # ]: 0 : else if (xc_funcs(2)%id <= 0) then
794 : : if (xc_funcs(1)%id /= 0) then
795 : 0 : call c_f_pointer(xc_functional_get_name(xc_funcs(1)%id),strg_c)
796 : 0 : call xc_char_to_f(strg_c,libxc_functionals_fullname)
797 : : end if
798 : : else
799 : 0 : call c_f_pointer(xc_functional_get_name(xc_funcs(1)%id),strg_c)
800 : 0 : call xc_char_to_f(strg_c,libxc_functionals_fullname)
801 : 0 : call c_f_pointer(xc_functional_get_name(xc_funcs(2)%id),strg_c)
802 : 0 : call xc_char_to_f(strg_c,xcname)
803 : 0 : libxc_functionals_fullname=trim(libxc_functionals_fullname)//'+'//trim(xcname)
804 : : end if
805 : : libxc_functionals_fullname=trim(libxc_functionals_fullname)
806 : : #endif
807 : :
808 [ # # ]: 0 : end function libxc_functionals_fullname
809 : : !!***
810 : :
811 : : !----------------------------------------------------------------------
812 : :
813 : : !!****f* libxc_functionals/libxc_functionals_getid
814 : : !! NAME
815 : : !! libxc_functionals_getid
816 : : !!
817 : : !! FUNCTION
818 : : !! Return identifer of a XC functional from its name
819 : : !! Return -1 if undefined
820 : : !!
821 : : !! INPUTS
822 : : !! xcname= string containing the name of a XC functional
823 : : !!
824 : : !! SOURCE
825 : :
826 : 327305 : function libxc_functionals_getid(xcname)
827 : :
828 : : !Arguments ------------------------------------
829 : : integer :: libxc_functionals_getid
830 : : character(len=*),intent(in) :: xcname
831 : : !Local variables-------------------------------
832 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
833 : : character(len=256) :: str
834 : 654610 : character(kind=C_CHAR,len=1),target :: name_c(len_trim(xcname)+1)
835 : 654610 : character(kind=C_CHAR,len=1),target :: name_c_xc(len_trim(xcname)-2)
836 : : type(C_PTR) :: name_c_ptr
837 : : #endif
838 : :
839 : : ! *************************************************************************
840 : :
841 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
842 : 327305 : str=trim(xcname)
843 [ + + - + ]: 327305 : if (xcname(1:3)=="XC_".or.xcname(1:3)=="xc_") then
844 [ + - ]: 326590 : str=xcname(4:);name_c_xc=xc_char_to_c(str)
845 : 326590 : name_c_ptr=c_loc(name_c_xc)
846 : : else
847 : 715 : name_c=xc_char_to_c(str)
848 : 715 : name_c_ptr=c_loc(name_c)
849 : : end if
850 : 327305 : libxc_functionals_getid=int(xc_functional_get_number(name_c_ptr))
851 : : #else
852 : : libxc_functionals_getid=-1
853 : : if (.false.) write(std_out,*) xcname
854 : : #endif
855 : :
856 [ + - ]: 327305 : end function libxc_functionals_getid
857 : : !!***
858 : :
859 : : !----------------------------------------------------------------------
860 : :
861 : : !!****f* libxc_functionals/libxc_functionals_family_from_id
862 : : !! NAME
863 : : !! libxc_functionals_family_from_id
864 : : !!
865 : : !! FUNCTION
866 : : !! Return family of a XC functional from its id
867 : : !!
868 : : !! INPUTS
869 : : !! xcid= id of a LibXC functional
870 : : !!
871 : : !! SOURCE
872 : :
873 : 35658 : function libxc_functionals_family_from_id(xcid)
874 : :
875 : : !Arguments ------------------------------------
876 : : integer :: libxc_functionals_family_from_id
877 : : integer,intent(in) :: xcid
878 : : !Local variables-------------------------------
879 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
880 : : integer(C_INT) :: xcid_c
881 : : #endif
882 : :
883 : : ! *************************************************************************
884 : :
885 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
886 : 35658 : xcid_c=int(xcid,kind=C_INT)
887 [ + + ]: 35658 : libxc_functionals_family_from_id=int(xc_family_from_id(xcid_c,C_NULL_PTR,C_NULL_PTR))
888 : : #else
889 : : libxc_functionals_family_from_id=-1
890 : : if (.false.) write(std_out,*) xcid
891 : : #endif
892 : :
893 : 28120 : end function libxc_functionals_family_from_id
894 : : !!***
895 : :
896 : : !----------------------------------------------------------------------
897 : :
898 : : !!****f* libxc_functionals/libxc_functionals_ixc
899 : : !! NAME
900 : : !! libxc_functionals_ixc
901 : : !!
902 : : !! FUNCTION
903 : : !! Return the value of ixc used to initialize the XC structure
904 : : !!
905 : : !! INPUTS
906 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
907 : : !! Handle for XC functionals
908 : : !!
909 : : !! SOURCE
910 : :
911 : 397566 : function libxc_functionals_ixc(xc_functionals)
912 : :
913 : : !Arguments ------------------------------------
914 : : integer :: libxc_functionals_ixc
915 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
916 : :
917 : : ! *************************************************************************
918 : :
919 [ + + ]: 397566 : if (present(xc_functionals)) then
920 : 1545 : libxc_functionals_ixc=xc_functionals(1)%abi_ixc
921 : : else
922 : 396021 : libxc_functionals_ixc=xc_global(1)%abi_ixc
923 : : end if
924 : :
925 : 397566 : end function libxc_functionals_ixc
926 : : !!***
927 : :
928 : : !----------------------------------------------------------------------
929 : :
930 : : !!****f* libxc_functionals/libxc_functionals_islda
931 : : !! NAME
932 : : !! libxc_functionals_islda
933 : : !!
934 : : !! FUNCTION
935 : : !! Test function to identify whether the presently used (set of) functional(s)
936 : : !! is a LDA or not
937 : : !!
938 : : !! INPUTS
939 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
940 : : !! Handle for XC functionals
941 : : !!
942 : : !! SOURCE
943 : :
944 : 1344 : function libxc_functionals_islda(xc_functionals)
945 : :
946 : : !Arguments ------------------------------------
947 : : logical :: libxc_functionals_islda
948 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
949 : :
950 : : ! *************************************************************************
951 : :
952 : 1344 : libxc_functionals_islda = .false.
953 [ - + ]: 1344 : if (.not.libxc_constants_initialized) call libxc_functionals_constants_load()
954 : :
955 [ + - ]: 1344 : if (present(xc_functionals)) then
956 : : libxc_functionals_islda=(any(xc_functionals%family==XC_FAMILY_LDA) .or. &
957 [ + + + + : 5402 : & any(xc_functionals%family==XC_FAMILY_HYB_LDA))
+ + + - ]
958 : : else
959 : : libxc_functionals_islda=(any(xc_global%family==XC_FAMILY_LDA) .or. &
960 [ # # # # : 0 : & any(xc_global%family==XC_FAMILY_HYB_LDA))
# # # # ]
961 : : end if
962 : :
963 : 1344 : end function libxc_functionals_islda
964 : : !!***
965 : :
966 : : !----------------------------------------------------------------------
967 : :
968 : : !!****f* libxc_functionals/libxc_functionals_isgga
969 : : !! NAME
970 : : !! libxc_functionals_isgga
971 : : !!
972 : : !! FUNCTION
973 : : !! Test function to identify whether the presently used (set of) functional(s)
974 : : !! is a GGA or not
975 : : !!
976 : : !! INPUTS
977 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
978 : : !! Handle for XC functionals
979 : : !!
980 : : !! SOURCE
981 : :
982 : 899966 : function libxc_functionals_isgga(xc_functionals)
983 : :
984 : : !Arguments ------------------------------------
985 : : logical :: libxc_functionals_isgga
986 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
987 : :
988 : : ! *************************************************************************
989 : :
990 : 899966 : libxc_functionals_isgga = .false.
991 [ - + ]: 899966 : if (.not.libxc_constants_initialized) call libxc_functionals_constants_load()
992 : :
993 [ + + ]: 899966 : if (present(xc_functionals)) then
994 : : libxc_functionals_isgga=(any(xc_functionals%family==XC_FAMILY_GGA) .or. &
995 [ + + + + : 1659892 : & any(xc_functionals%family==XC_FAMILY_HYB_GGA))
+ + + + ]
996 : : else
997 : : libxc_functionals_isgga=(any(xc_global%family==XC_FAMILY_GGA) .or. &
998 [ + + + + : 2166480 : & any(xc_global%family==XC_FAMILY_HYB_GGA))
+ + + + ]
999 : : end if
1000 : :
1001 : 899966 : end function libxc_functionals_isgga
1002 : : !!***
1003 : :
1004 : : !----------------------------------------------------------------------
1005 : :
1006 : : !!****f* libxc_functionals/libxc_functionals_ismgga
1007 : : !! NAME
1008 : : !! libxc_functionals_ismgga
1009 : : !!
1010 : : !! FUNCTION
1011 : : !! Test function to identify whether the presently used (set of) functional(s)
1012 : : !! is a Meta-GGA or not
1013 : : !!
1014 : : !! INPUTS
1015 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1016 : : !! Handle for XC functionals
1017 : : !!
1018 : : !! SOURCE
1019 : :
1020 : 911961 : function libxc_functionals_ismgga(xc_functionals)
1021 : :
1022 : : !Arguments ------------------------------------
1023 : : logical :: libxc_functionals_ismgga
1024 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
1025 : :
1026 : : ! *************************************************************************
1027 : :
1028 : 911961 : libxc_functionals_ismgga = .false.
1029 [ - + ]: 911961 : if (.not.libxc_constants_initialized) call libxc_functionals_constants_load()
1030 : :
1031 [ + + ]: 911961 : if (present(xc_functionals)) then
1032 : : libxc_functionals_ismgga=(any(xc_functionals%family==XC_FAMILY_MGGA) .or. &
1033 [ + + + + : 1638344 : & any(xc_functionals%family==XC_FAMILY_HYB_MGGA))
+ + + - ]
1034 : : else
1035 : : libxc_functionals_ismgga=(any(xc_global%family==XC_FAMILY_MGGA) .or. &
1036 [ + + + + : 2309293 : & any(xc_global%family==XC_FAMILY_HYB_MGGA))
+ + + - ]
1037 : : end if
1038 : :
1039 : 911961 : end function libxc_functionals_ismgga
1040 : : !!***
1041 : :
1042 : : !----------------------------------------------------------------------
1043 : :
1044 : : !!****f* libxc_functionals/libxc_functionals_is_tb09
1045 : : !! NAME
1046 : : !! libxc_functionals_is_tb09
1047 : : !!
1048 : : !! FUNCTION
1049 : : !! Test function to identify whether the presently used functional
1050 : : !! is Tran-Blaha 2009 or not
1051 : : !!
1052 : : !! INPUTS
1053 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1054 : : !! Handle for XC functionals
1055 : : !!
1056 : : !! SOURCE
1057 : :
1058 : 74051 : logical function libxc_functionals_is_tb09(xc_functionals) result(ans)
1059 : :
1060 : : !Arguments ------------------------------------
1061 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
1062 : : !Local variables-------------------------------
1063 : : integer :: id_tb09
1064 : :
1065 : : ! *************************************************************************
1066 : :
1067 : 74051 : ans = .false.
1068 : 74051 : id_tb09 = libxc_functionals_getid('XC_MGGA_X_TB09')
1069 : :
1070 [ + - ]: 74051 : if (present(xc_functionals)) then
1071 [ # # # # ]: 0 : ans = any(xc_functionals%id == id_tb09)
1072 : : else
1073 [ + + + + ]: 221580 : ans = any(xc_global%id == id_tb09)
1074 : : end if
1075 : :
1076 : 74051 : end function libxc_functionals_is_tb09
1077 : : !!***
1078 : :
1079 : : !----------------------------------------------------------------------
1080 : :
1081 : : !!****f* libxc_functionals/libxc_functionals_is_potential_only
1082 : : !! NAME
1083 : : !! libxc_functionals_is_potential_only
1084 : : !!
1085 : : !! FUNCTION
1086 : : !! Test function to identify whether the presently used (set of) functional(s)
1087 : : !! provides a potential-only functional
1088 : : !!
1089 : : !! INPUTS
1090 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1091 : : !! Handle for XC functionals
1092 : : !!
1093 : : !! SOURCE
1094 : :
1095 : 2413 : logical function libxc_functionals_is_potential_only(xc_functionals) result(ans)
1096 : :
1097 : : !Arguments ------------------------------------
1098 : : type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2)
1099 : : !Local variables-------------------------------
1100 : : integer :: id_tb09,id_bj06
1101 : :
1102 : : ! *************************************************************************
1103 : :
1104 : 2413 : ans = .false.
1105 : 2413 : id_tb09 = libxc_functionals_getid('XC_MGGA_X_TB09')
1106 : 2413 : id_bj06 = libxc_functionals_getid('XC_MGGA_X_BJ06')
1107 : :
1108 [ - + ]: 2413 : if (present(xc_functionals)) then
1109 : : ans = (any(xc_functionals%id == id_tb09) .or. &
1110 [ + + + + : 14444 : & any(xc_functionals%id == id_bj06))
+ + + + ]
1111 : : else
1112 : : ans = (any(xc_global%id == id_tb09) .or. &
1113 [ # # # # : 0 : & any(xc_global%id == id_bj06))
# # # # ]
1114 : : end if
1115 : :
1116 : 2413 : end function libxc_functionals_is_potential_only
1117 : : !!***
1118 : :
1119 : : !----------------------------------------------------------------------
1120 : :
1121 : : !!****f* libxc_functionals/libxc_functionals_set_c_tb09
1122 : : !! NAME
1123 : : !! libxc_functionals_set_c_tb09
1124 : : !!
1125 : : !! FUNCTION
1126 : : !! Set c parameter for the Tran-Blaha 2009 functional
1127 : : !!
1128 : : !! INPUTS
1129 : : !! xc_c_tb09= value of the c parameter to set for the TB09 functional
1130 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1131 : : !! Handle for XC functionals
1132 : : !!
1133 : : !! SOURCE
1134 : :
1135 : 71 : subroutine libxc_functionals_set_c_tb09(xc_tb09_c,xc_functionals)
1136 : :
1137 : : !Arguments ------------------------------------
1138 : : real(dp),intent(in) :: xc_tb09_c
1139 : : type(libxc_functional_type),intent(inout),optional :: xc_functionals(2)
1140 : : !Local variables -------------------------------
1141 : : integer :: id_tb09,ii
1142 : :
1143 : : ! *************************************************************************
1144 : :
1145 : 71 : id_tb09 = libxc_functionals_getid('XC_MGGA_X_TB09')
1146 : :
1147 [ + - ]: 71 : if (present(xc_functionals)) then
1148 [ # # ]: 0 : do ii=1,2
1149 [ # # ]: 0 : if (xc_functionals(ii)%id == id_tb09) then
1150 : 0 : xc_functionals(ii)%xc_tb09_c = xc_tb09_c
1151 : : end if
1152 : : end do
1153 : : else
1154 [ + + ]: 213 : do ii=1,2
1155 [ + + ]: 213 : if (xc_global(ii)%id == id_tb09) then
1156 : 71 : xc_global(ii)%xc_tb09_c = xc_tb09_c
1157 : : end if
1158 : : end do
1159 : : end if
1160 : :
1161 : 71 : end subroutine libxc_functionals_set_c_tb09
1162 : : !!***
1163 : :
1164 : : !----------------------------------------------------------------------
1165 : :
1166 : : !!****f* libxc_functionals/libxc_functionals_needs_tau
1167 : : !! NAME
1168 : : !! libxc_functionals_needs_tau
1169 : : !!
1170 : : !! FUNCTION
1171 : : !! Test function to identify whether the presently used (set of) functional(s)
1172 : : !! needs the kinetic energy density or not
1173 : : !!
1174 : : !! INPUTS
1175 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1176 : : !! Handle for XC functionals
1177 : : !!
1178 : : !! SOURCE
1179 : :
1180 : 902414 : function libxc_functionals_needs_tau(xc_functionals)
1181 : :
1182 : : !Arguments ------------------------------------
1183 : : logical :: libxc_functionals_needs_tau
1184 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
1185 : :
1186 : : ! *************************************************************************
1187 : :
1188 : 902414 : libxc_functionals_needs_tau = .false.
1189 : :
1190 [ + + ]: 902414 : if (present(xc_functionals)) then
1191 [ + + + + ]: 861656 : libxc_functionals_needs_tau=(any(xc_functionals%needs_tau))
1192 : : else
1193 [ + + + + ]: 1234656 : libxc_functionals_needs_tau=(any(xc_global%needs_tau))
1194 : : end if
1195 : :
1196 : 902414 : end function libxc_functionals_needs_tau
1197 : : !!***
1198 : :
1199 : : !----------------------------------------------------------------------
1200 : :
1201 : : !!****f* libxc_functionals/libxc_functionals_needs_laplacian
1202 : : !! NAME
1203 : : !! libxc_functionals_needs_laplacian
1204 : : !!
1205 : : !! FUNCTION
1206 : : !! Test function to identify whether the presently used (set of) functional(s)
1207 : : !! needs the laplacian of the density or not
1208 : : !!
1209 : : !! INPUTS
1210 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1211 : : !! Handle for XC functionals
1212 : : !!
1213 : : !! SOURCE
1214 : :
1215 : 898759 : function libxc_functionals_needs_laplacian(xc_functionals)
1216 : :
1217 : : !Arguments ------------------------------------
1218 : : logical :: libxc_functionals_needs_laplacian
1219 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
1220 : :
1221 : : ! *************************************************************************
1222 : :
1223 : 898759 : libxc_functionals_needs_laplacian = .false.
1224 : :
1225 [ + + ]: 898759 : if (present(xc_functionals)) then
1226 [ + + + + ]: 1087749 : libxc_functionals_needs_laplacian=(any(xc_functionals%needs_laplacian))
1227 : : else
1228 [ + + + + ]: 1467680 : libxc_functionals_needs_laplacian=(any(xc_global%needs_laplacian))
1229 : : end if
1230 : :
1231 : 898759 : end function libxc_functionals_needs_laplacian
1232 : : !!***
1233 : :
1234 : : !----------------------------------------------------------------------
1235 : :
1236 : : !!****f* libxc_functionals/libxc_functionals_needs_temperature
1237 : : !! NAME
1238 : : !! libxc_functionals_needs_temperature
1239 : : !!
1240 : : !! FUNCTION
1241 : : !! Test function to identify whether the presently used (set of) functional(s)
1242 : : !! needs the electronic temperature or not
1243 : : !!
1244 : : !! INPUTS
1245 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1246 : : !! Handle for XC functionals
1247 : : !!
1248 : : !! SOURCE
1249 : :
1250 : 0 : function libxc_functionals_needs_temperature(xc_functionals)
1251 : :
1252 : : !Arguments ------------------------------------
1253 : : logical :: libxc_functionals_needs_temperature
1254 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
1255 : :
1256 : : ! *************************************************************************
1257 : :
1258 : 0 : libxc_functionals_needs_temperature = .false.
1259 : :
1260 [ # # ]: 0 : if (present(xc_functionals)) then
1261 [ # # # # ]: 0 : libxc_functionals_needs_temperature=(any(xc_functionals%temperature>tol8))
1262 : : else
1263 [ # # # # ]: 0 : libxc_functionals_needs_temperature=(any(xc_global%temperature>tol8))
1264 : : end if
1265 : :
1266 : 0 : end function libxc_functionals_needs_temperature
1267 : : !!***
1268 : :
1269 : : !----------------------------------------------------------------------
1270 : :
1271 : : !!****f* libxc_functionals/libxc_functionals_set_temperature
1272 : : !! NAME
1273 : : !! libxc_functionals_set_temperature
1274 : : !!
1275 : : !! FUNCTION
1276 : : !! Set the electronic temperature in a (set of) of XC functional(s)
1277 : : !! No action when no temperature dependence
1278 : : !!
1279 : : !! INPUTS
1280 : : !! temperature=electronic temperature (in Kelvin units)
1281 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1282 : : !! Handle for XC functionals
1283 : : !!
1284 : : !! OUTPUT
1285 : : !!
1286 : : !! SOURCE
1287 : :
1288 : 0 : subroutine libxc_functionals_set_temperature(temperature,xc_functionals)
1289 : :
1290 : : !Arguments ------------------------------------
1291 : : real(dp),intent(in) :: temperature
1292 : : type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2)
1293 : : !Local variables -------------------------------
1294 : : integer :: ii
1295 : : type(libxc_functional_type),pointer :: xc_func
1296 : :
1297 : : ! *************************************************************************
1298 : :
1299 [ # # ]: 0 : do ii = 1, 2
1300 : :
1301 : : ! Select XC functional
1302 [ # # ]: 0 : if (present(xc_functionals)) then
1303 : 0 : xc_func => xc_functionals(ii)
1304 : : else
1305 : 0 : xc_func => xc_global(ii)
1306 : : end if
1307 : :
1308 [ # # ]: 0 : if (xc_func%id>0) then
1309 : 0 : call libxc_functionals_set_temp(xc_func,temperature)
1310 : : end if
1311 : :
1312 : : end do
1313 : :
1314 : 0 : end subroutine libxc_functionals_set_temperature
1315 : : !!***
1316 : :
1317 : : !----------------------------------------------------------------------
1318 : :
1319 : : !!****f* libxc_functionals/libxc_functionals_has_kxc
1320 : : !! NAME
1321 : : !! libxc_functionals_has_kxc
1322 : : !!
1323 : : !! FUNCTION
1324 : : !! Test function to identify whether the presently used (set of) functional(s)
1325 : : !! provides Kxc or not (fxc in the libXC convention)
1326 : : !!
1327 : : !! INPUTS
1328 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1329 : : !! Handle for XC functionals
1330 : : !!
1331 : : !! SOURCE
1332 : :
1333 : 515876 : function libxc_functionals_has_kxc(xc_functionals)
1334 : :
1335 : : !Arguments ------------------------------------
1336 : : logical :: libxc_functionals_has_kxc
1337 : : type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2)
1338 : : !Local variables-------------------------------
1339 : : integer :: ii
1340 : :
1341 : : ! *************************************************************************
1342 : :
1343 : 515876 : libxc_functionals_has_kxc=.true.
1344 : :
1345 [ + + ]: 1547628 : do ii=1,2
1346 [ + + ]: 1547628 : if (present(xc_functionals)) then
1347 [ + + ]: 5400 : if (.not.xc_functionals(ii)%has_fxc) libxc_functionals_has_kxc=.false.
1348 : : else
1349 [ + + ]: 2048063 : if (.not.xc_global(ii)%has_fxc) libxc_functionals_has_kxc=.false.
1350 : : end if
1351 : : end do
1352 : :
1353 : 515876 : end function libxc_functionals_has_kxc
1354 : : !!***
1355 : :
1356 : : !----------------------------------------------------------------------
1357 : :
1358 : : !!****f* libxc_functionals/libxc_functionals_has_k3xc
1359 : : !! NAME
1360 : : !! libxc_functionals_has_k3xc
1361 : : !!
1362 : : !! FUNCTION
1363 : : !! Test function to identify whether the presently used (set of) functional(s)
1364 : : !! provides K3xc or not (kxc in the libXC convention)
1365 : : !!
1366 : : !! INPUTS
1367 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1368 : : !! Handle for XC functionals
1369 : : !!
1370 : : !! SOURCE
1371 : :
1372 : 514721 : function libxc_functionals_has_k3xc(xc_functionals)
1373 : :
1374 : : !Arguments ------------------------------------
1375 : : logical :: libxc_functionals_has_k3xc
1376 : : type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2)
1377 : : !Local variables-------------------------------
1378 : : integer :: ii
1379 : :
1380 : : ! *************************************************************************
1381 : :
1382 : 514721 : libxc_functionals_has_k3xc=.true.
1383 : :
1384 [ + + ]: 1544163 : do ii=1,2
1385 [ + + ]: 1544163 : if (present(xc_functionals)) then
1386 [ + + ]: 3090 : if (.not.xc_functionals(ii)%has_kxc) libxc_functionals_has_k3xc=.false.
1387 : : else
1388 [ + + ]: 2045753 : if (.not.xc_global(ii)%has_kxc) libxc_functionals_has_k3xc=.false.
1389 : : end if
1390 : : end do
1391 : :
1392 : 514721 : end function libxc_functionals_has_k3xc
1393 : : !!***
1394 : :
1395 : : !----------------------------------------------------------------------
1396 : :
1397 : : !!****f* libxc_functionals/libxc_functionals_nspin
1398 : : !! NAME
1399 : : !! libxc_functionals_nspin
1400 : : !!
1401 : : !! FUNCTION
1402 : : !! Returns the number of spin components for the (set of) XC functional(s)
1403 : : !!
1404 : : !! INPUTS
1405 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1406 : : !! Handle for XC functionals
1407 : : !!
1408 : : !! SOURCE
1409 : :
1410 : 255 : function libxc_functionals_nspin(xc_functionals)
1411 : :
1412 : : !Arguments ------------------------------------
1413 : : integer :: libxc_functionals_nspin
1414 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
1415 : :
1416 : : ! *************************************************************************
1417 : :
1418 : 255 : libxc_functionals_nspin = 1
1419 : :
1420 [ + - ]: 255 : if (present(xc_functionals)) then
1421 [ # # # # : 0 : if (any(xc_functionals%nspin==2)) libxc_functionals_nspin=2
# # ]
1422 : : else
1423 [ + + + + : 675 : if (any(xc_global%nspin==2)) libxc_functionals_nspin=2
+ + ]
1424 : : end if
1425 : :
1426 : 255 : end function libxc_functionals_nspin
1427 : : !!***
1428 : :
1429 : : !----------------------------------------------------------------------
1430 : :
1431 : : !!****f* libxc_functionals/libxc_functionals_is_hybrid
1432 : : !! NAME
1433 : : !! libxc_functionals_is_hybrid
1434 : : !!
1435 : : !! FUNCTION
1436 : : !! Test function to identify whether the presently used (set of) functional(s)
1437 : : !! is hybrid or not
1438 : : !!
1439 : : !! INPUTS
1440 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1441 : : !! Handle for XC functionals
1442 : : !!
1443 : : !! SOURCE
1444 : :
1445 : 546275 : function libxc_functionals_is_hybrid(xc_functionals)
1446 : :
1447 : : !Arguments ------------------------------------
1448 : : logical :: libxc_functionals_is_hybrid
1449 : : type(libxc_functional_type),intent(in),optional :: xc_functionals(2)
1450 : :
1451 : : ! *************************************************************************
1452 : :
1453 : 546275 : libxc_functionals_is_hybrid = .false.
1454 : :
1455 [ + + ]: 546275 : if (present(xc_functionals)) then
1456 [ + + + + ]: 5179 : libxc_functionals_is_hybrid=(any(xc_functionals%is_hybrid))
1457 : : else
1458 [ + + + + ]: 1625997 : libxc_functionals_is_hybrid=(any(xc_global%is_hybrid))
1459 : : end if
1460 : :
1461 : 546275 : end function libxc_functionals_is_hybrid
1462 : : !!***
1463 : :
1464 : : !----------------------------------------------------------------------
1465 : :
1466 : : !!****f* libxc_functionals/libxc_functionals_is_hybrid_from_id
1467 : : !! NAME
1468 : : !! libxc_functionals_is_hybrid_from_id
1469 : : !!
1470 : : !! FUNCTION
1471 : : !! Test function to identify whether a functional is hybrid or not, from its id
1472 : : !!
1473 : : !! INPUTS
1474 : : !! xcid= id of a LibXC functional
1475 : : !!
1476 : : !! SOURCE
1477 : :
1478 : 29051 : function libxc_functionals_is_hybrid_from_id(xcid)
1479 : :
1480 : : !Arguments ------------------------------------
1481 : : logical :: libxc_functionals_is_hybrid_from_id
1482 : : integer,intent(in) :: xcid
1483 : : !Local variables-------------------------------
1484 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1485 : : integer(C_INT) :: xcid_c
1486 : : #endif
1487 : :
1488 : : ! *************************************************************************
1489 : :
1490 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1491 : 29051 : xcid_c=int(xcid,kind=C_INT)
1492 : 28120 : libxc_functionals_is_hybrid_from_id =(xc_func_is_hybrid_from_id(xcid_c)==1)
1493 : : #else
1494 : : libxc_functionals_is_hybrid_from_id = .false.
1495 : : if (.false.) write(std_out,*) xcid
1496 : : #endif
1497 : :
1498 : 28120 : end function libxc_functionals_is_hybrid_from_id
1499 : : !!***
1500 : :
1501 : : !----------------------------------------------------------------------
1502 : :
1503 : : !!****f* libxc_functionals/libxc_functionals_get_hybridparams
1504 : : !! NAME
1505 : : !! libxc_functionals_get_hybridparams
1506 : : !!
1507 : : !! FUNCTION
1508 : : !! Returns the parameters of an hybrid functional (mixing coefficient(s) and range separation)
1509 : : !! Applies on a (set of) functional(s)
1510 : : !!
1511 : : !! INPUTS
1512 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1513 : : !! Handle for XC functionals
1514 : : !!
1515 : : !! OUTPUT
1516 : : !! [hyb_mixing] = mixing factor of Fock contribution
1517 : : !! [hyb_mixing_sr]= mixing factor of short-range Fock contribution
1518 : : !! [hyb_range] = Range (for separation)
1519 : : !!
1520 : : !! SOURCE
1521 : :
1522 : 358093 : subroutine libxc_functionals_get_hybridparams(hyb_mixing,hyb_mixing_sr,hyb_range,xc_functionals)
1523 : :
1524 : : !Arguments ------------------------------------
1525 : : real(dp),intent(out),optional :: hyb_mixing,hyb_mixing_sr,hyb_range
1526 : : type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2)
1527 : : !Local variables -------------------------------
1528 : : integer :: ii
1529 : : character(len=500) :: msg
1530 : : type(libxc_functional_type),pointer :: xc_func
1531 : :
1532 : : ! *************************************************************************
1533 : :
1534 [ + + ]: 358093 : if (present(hyb_mixing )) hyb_mixing =zero
1535 [ + + ]: 358093 : if (present(hyb_mixing_sr)) hyb_mixing_sr=zero
1536 [ + - ]: 358093 : if (present(hyb_range )) hyb_range =zero
1537 : :
1538 [ + + ]: 1074279 : do ii = 1, 2
1539 : :
1540 : : ! Select XC functional
1541 [ + + ]: 716186 : if (present(xc_functionals)) then
1542 : 2160 : xc_func => xc_functionals(ii)
1543 : : else
1544 : 714026 : xc_func => xc_global(ii)
1545 : : end if
1546 : :
1547 : : ! Mixing coefficient for the Fock contribution
1548 [ + + ]: 716186 : if (present(hyb_mixing)) then
1549 [ + + ]: 715734 : if (abs(xc_func%hyb_mixing) > tol8) then
1550 [ + - ]: 190 : if (abs(hyb_mixing) <= tol8) then
1551 : 190 : hyb_mixing=xc_func%hyb_mixing
1552 : : else
1553 : 0 : msg='Invalid XC functional: contains 2 hybrid exchange functionals!'
1554 : 0 : ABI_ERROR(msg)
1555 : : end if
1556 : : end if
1557 : : end if
1558 : :
1559 : : ! Mixing coefficient for the short-range Fock contribution
1560 [ + + ]: 716186 : if (present(hyb_mixing_sr)) then
1561 [ + + ]: 715734 : if (abs(xc_func%hyb_mixing_sr) > tol8) then
1562 [ + - ]: 2670 : if (abs(hyb_mixing_sr) <= tol8) then
1563 : 2670 : hyb_mixing_sr=xc_func%hyb_mixing_sr
1564 : : else
1565 : 0 : msg='Invalid XC functional: contains 2 hybrid exchange functionals!'
1566 : 0 : ABI_ERROR(msg)
1567 : : end if
1568 : : end if
1569 : : end if
1570 : :
1571 : : ! Range separation
1572 [ + - ]: 1074279 : if (present(hyb_range)) then
1573 [ + + ]: 716186 : if (abs(xc_func%hyb_range) > tol8) then
1574 [ + - ]: 2673 : if (abs(hyb_range) <= tol8) then
1575 : 2673 : hyb_range=xc_func%hyb_range
1576 : : else
1577 : 0 : msg='Invalid XC functional: contains 2 hybrid exchange functionals!'
1578 : 0 : ABI_ERROR(msg)
1579 : : end if
1580 : : end if
1581 : : end if
1582 : :
1583 : : end do
1584 : :
1585 : 358093 : end subroutine libxc_functionals_get_hybridparams
1586 : : !!***
1587 : :
1588 : : !----------------------------------------------------------------------
1589 : :
1590 : : !!****f* libxc_functionals/libxc_functionals_set_hybridparams
1591 : : !! NAME
1592 : : !! libxc_functionals_set_hybridparams
1593 : : !!
1594 : : !! FUNCTION
1595 : : !! Set the parameters of an hybrid functional (mixing coefficient(s) and range separation)
1596 : : !! Applies on a (set of) functional(s)
1597 : : !!
1598 : : !! INPUTS
1599 : : !! [hyb_mixing] = mixing factor of Fock contribution
1600 : : !! [hyb_mixing_sr] = mixing factor of short-range Fock contribution
1601 : : !! [hyb_range] = Range (for separation)
1602 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1603 : : !! Handle for XC functionals
1604 : : !!
1605 : : !! OUTPUT
1606 : : !!
1607 : : !! SOURCE
1608 : :
1609 : 49 : subroutine libxc_functionals_set_hybridparams(hyb_mixing,hyb_mixing_sr,hyb_range,xc_functionals)
1610 : :
1611 : : !Arguments ------------------------------------
1612 : : real(dp),intent(in),optional :: hyb_mixing,hyb_mixing_sr,hyb_range
1613 : : type(libxc_functional_type),intent(in),optional,target :: xc_functionals(2)
1614 : : !Local variables -------------------------------
1615 : : integer :: ii,id_pbe0,id_hse03,id_hse06
1616 : : logical :: is_pbe0,is_hse
1617 : : integer :: func_id(2)
1618 : : character(len=500) :: msg
1619 : : type(libxc_functional_type),pointer :: xc_func
1620 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1621 : : integer(C_INT) :: npar_c
1622 : : real(C_DOUBLE) :: alpha_c,beta_c,omega_c,param_c(3)
1623 : : #endif
1624 : :
1625 : : ! *************************************************************************
1626 : :
1627 : 49 : is_pbe0=.false.
1628 : 49 : is_hse =.false.
1629 : 49 : id_pbe0=libxc_functionals_getid('HYB_GGA_XC_PBEH')
1630 : 49 : id_hse03=libxc_functionals_getid('HYB_GGA_XC_HSE03')
1631 : 49 : id_hse06=libxc_functionals_getid('HYB_GGA_XC_HSE06')
1632 : :
1633 [ + + ]: 147 : do ii = 1, 2
1634 : :
1635 : : ! Select XC functional
1636 [ + + ]: 98 : if (present(xc_functionals)) then
1637 : 2 : xc_func => xc_functionals(ii)
1638 : : else
1639 : 96 : xc_func => xc_global(ii)
1640 : : end if
1641 : 98 : func_id(ii)=xc_func%id
1642 : :
1643 : : ! Doesnt work with all hybrid functionals
1644 [ - + ]: 98 : if (is_pbe0.or.is_hse) then
1645 : 0 : msg='Invalid XC functional: contains 2 hybrid exchange functionals!'
1646 : 0 : ABI_ERROR(msg)
1647 : : end if
1648 : 98 : is_pbe0=(xc_func%id==id_pbe0)
1649 [ + + + + ]: 98 : is_hse=((xc_func%id==id_hse03).or.(xc_func%id==id_hse06))
1650 [ + + ]: 98 : if ((.not.is_pbe0).and.(.not.is_hse)) cycle
1651 : :
1652 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1653 : : ! New values for parameters
1654 : :
1655 : : ! PBE0 type functionals
1656 [ + - ]: 49 : if (present(hyb_mixing))then
1657 : 49 : xc_func%hyb_mixing=hyb_mixing
1658 : 49 : alpha_c=real(xc_func%hyb_mixing,kind=C_DOUBLE)
1659 [ + + ]: 49 : if (is_pbe0) then
1660 : 9 : npar_c=int(1,kind=C_INT) ; param_c(1)=alpha_c
1661 : 9 : call xc_func_set_params(xc_func%conf,param_c,npar_c)
1662 : : endif
1663 : : endif
1664 : :
1665 : : ! HSE type functionals
1666 [ + - ]: 98 : if(present(hyb_mixing_sr).or.present(hyb_range)) then
1667 [ + - ]: 49 : if (present(hyb_mixing_sr)) xc_func%hyb_mixing_sr=hyb_mixing_sr
1668 [ + - ]: 49 : if (present(hyb_range)) xc_func%hyb_range=hyb_range
1669 : 49 : beta_c =real(xc_func%hyb_mixing_sr,kind=C_DOUBLE)
1670 : 49 : omega_c=real(xc_func%hyb_range,kind=C_DOUBLE)
1671 [ + + ]: 49 : if (is_hse) then
1672 : 40 : npar_c=int(3,kind=C_INT)
1673 [ + + ]: 120 : param_c(1)=beta_c;param_c(2:3)=omega_c
1674 : 40 : call xc_func_set_params(xc_func%conf,param_c,npar_c)
1675 : : endif
1676 : : end if
1677 : :
1678 : : #else
1679 : : ABI_UNUSED(hyb_mixing)
1680 : : ABI_UNUSED(hyb_mixing_sr)
1681 : : ABI_UNUSED(hyb_range)
1682 : : #endif
1683 : :
1684 : : end do
1685 : :
1686 [ - + ]: 49 : if ((.not.is_pbe0).and.(.not.is_hse)) then
1687 : 0 : write(msg,'(3a,2i6,a,a,i6,a,i6,a,i6,a)')'Invalid XC functional: not able to change parameters for this functional !',ch10,&
1688 : 0 : & 'The IDs are ',func_id(:),ch10,&
1689 : 0 : & 'Allowed HYB_GGA_XC_PBEH, HYB_GGA_XC_HSE03, and HYB_GGA_XC_HSE06 with IDs =',id_pbe0,',',id_hse03,',',id_hse06,'.'
1690 : 0 : ABI_ERROR(msg)
1691 : : end if
1692 : :
1693 : 49 : end subroutine libxc_functionals_set_hybridparams
1694 : : !!***
1695 : :
1696 : : !----------------------------------------------------------------------
1697 : :
1698 : : !!****f* libxc_functionals/libxc_functionals_gga_from_hybrid
1699 : : !! NAME
1700 : : !! libxc_functionals_gga_from_hybrid
1701 : : !!
1702 : : !! FUNCTION
1703 : : !! Returns a logical flag: TRUE if one can deduce, from the id of a hybrid functional set,
1704 : : !! the id(s) of the GGA functional on which it is based.
1705 : : !! Optionally returns the id of the GGA functional on which the hybrid functional is based
1706 : : !! (2 integers defining the GGA X and C functionals).
1707 : : !! - If an id is provided as input argument, it is used as input id;
1708 : : !! - If not, the input id is taken from the optional xc_functionals datastructure;
1709 : : !! - If no input argument is given, the input id is taken from the global xc_global datastructure.
1710 : : !!
1711 : : !! INPUTS
1712 : : !! [hybrid_id]=<type(libxc_functional_type)>, optional : id of an input hybrid functional
1713 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional : XC functionals from which
1714 : : !! the id(s) can be used
1715 : : !!
1716 : : !! OUTPUT
1717 : : !! [gga_id(2)]=array that contains the GGA libXC id(s)
1718 : : !! libxc_functionals_gga_from_hybrid=.true. if the GGA has been found from the input id
1719 : : !!
1720 : : !! SOURCE
1721 : :
1722 : 1225 : function libxc_functionals_gga_from_hybrid(gga_id,hybrid_id,xc_functionals)
1723 : :
1724 : : !Arguments ------------------------------------
1725 : : !scalars
1726 : : integer,intent(in),optional :: hybrid_id
1727 : : logical :: libxc_functionals_gga_from_hybrid
1728 : : !arrays
1729 : : integer,intent(out),optional :: gga_id(2)
1730 : : type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2)
1731 : : !Local variables -------------------------------
1732 : : !scalars
1733 : : integer :: ii
1734 : : logical :: is_hybrid
1735 : : character(len=100) :: c_name,x_name,msg
1736 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1737 : : character(len=100) :: xc_name
1738 : : character(kind=C_CHAR,len=1),pointer :: strg_c
1739 : : #endif
1740 : : !arrays
1741 : : integer :: trial_id(2)
1742 : :
1743 : : ! *************************************************************************
1744 : :
1745 : 1225 : libxc_functionals_gga_from_hybrid=.false.
1746 : :
1747 : 1225 : is_hybrid=.false.
1748 [ + + ]: 1225 : if (present(hybrid_id)) then
1749 : 931 : trial_id(1)=hybrid_id
1750 : 931 : trial_id(2)=0
1751 : 931 : is_hybrid=libxc_functionals_is_hybrid_from_id(trial_id(1))
1752 [ - + ]: 294 : else if (present(xc_functionals)) then
1753 : 0 : trial_id(1)=xc_functionals(1)%id
1754 : 0 : trial_id(2)=xc_functionals(2)%id
1755 : 0 : is_hybrid=libxc_functionals_is_hybrid(xc_functionals)
1756 : : else
1757 : 294 : trial_id(1)=xc_global(1)%id
1758 : 294 : trial_id(2)=xc_global(2)%id
1759 : 294 : is_hybrid=libxc_functionals_is_hybrid(xc_global)
1760 : : end if
1761 : :
1762 : 1225 : c_name="unknown" ; x_name="unknown"
1763 : :
1764 : : !Specific treatment of the B3LYP functional, whose GGA counterpart does not exist in LibXC
1765 [ + + + + ]: 1225 : if (trial_id(1)==402 .or. trial_id(2)==402) then
1766 : 42 : libxc_functionals_gga_from_hybrid=.true.
1767 [ + + ]: 42 : if (present(gga_id)) then
1768 : 10 : gga_id(1)=0
1769 : 10 : gga_id(2)=-1402 ! This corresponds to a native ABINIT functional,
1770 : : ! actually a composite from different LibXC functionals!
1771 : 10 : write(std_out,*)' libxc_functionals_gga_from_hybrid, return with gga_id=',gga_id
1772 : : endif
1773 : 42 : return
1774 : : endif
1775 : :
1776 [ + + ]: 3549 : do ii = 1, 2
1777 : :
1778 [ + + - + ]: 2366 : if ((trial_id(ii)<=0).or.(.not.is_hybrid)) cycle
1779 : :
1780 [ - + ]: 1183 : if (libxc_functionals_gga_from_hybrid) then
1781 : 0 : msg='Invalid XC functional setup: contains 2 hybrid functionals!'
1782 : 0 : ABI_ERROR(msg)
1783 : : end if
1784 : :
1785 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1786 : :
1787 : 1183 : call c_f_pointer(xc_functional_get_name(trial_id(ii)),strg_c)
1788 : 1183 : call xc_char_to_f(strg_c,xc_name)
1789 : :
1790 : : ! AVAILABLE FUNCTIONALS
1791 : :
1792 : : ! ===== PBE0 =====
1793 [ + + + + ]: 1183 : if (xc_name=="hyb_gga_xc_pbeh" .or. &
1794 : 1183 : & xc_name=="hyb_gga_xc_pbe0_13") then
1795 : 301 : c_name="GGA_C_PBE"
1796 : 301 : x_name="GGA_X_PBE"
1797 : 301 : libxc_functionals_gga_from_hybrid=.true.
1798 : :
1799 : : ! ===== HSE =====
1800 [ + + - + ]: 882 : else if (xc_name=="hyb_gga_xc_hse03" .or. &
1801 : : & xc_name=="hyb_gga_xc_hse06" ) then
1802 : 882 : c_name="GGA_C_PBE"
1803 : 882 : x_name="GGA_X_PBE"
1804 : 882 : libxc_functionals_gga_from_hybrid=.true.
1805 : : end if
1806 : :
1807 : :
1808 : : #endif
1809 : :
1810 : : enddo ! ii
1811 : :
1812 [ + + ]: 1183 : if (present(gga_id)) then
1813 [ + - ]: 284 : if (libxc_functionals_gga_from_hybrid) then
1814 : 284 : gga_id(1)=libxc_functionals_getid(c_name)
1815 : 284 : gga_id(2)=libxc_functionals_getid(x_name)
1816 : : else
1817 [ # # ]: 0 : gga_id(:)=-1
1818 : : end if
1819 : : end if
1820 : :
1821 : : !Note that in the case of B3LYP functional, the return happened immediately after the setup of B3LYP parameters.
1822 : :
1823 : : end function libxc_functionals_gga_from_hybrid
1824 : : !!***
1825 : :
1826 : : !----------------------------------------------------------------------
1827 : :
1828 : : !!****f* libxc_functionals/libxc_functionals_getvxc
1829 : : !! NAME
1830 : : !! libxc_functionals_getvxc
1831 : : !!
1832 : : !! FUNCTION
1833 : : !! Return XC potential and energy, from input density (gradient etc...)
1834 : : !!
1835 : : !! INPUTS
1836 : : !! ndvxc=size of dvxc
1837 : : !! nd2vxc=size of d2vxc
1838 : : !! npts=number of of points for the density
1839 : : !! nspden=number of spin-density components
1840 : : !! order=requested order of derivation
1841 : : !! rho(npts,nspden)=electronic density
1842 : : !! [grho2(npts,nspden)]=squared gradient of the density
1843 : : !! [lrho(npts,nspden)]=laplacian of the density
1844 : : !! [tau(npts,nspden)]= kinetic energy density
1845 : : !!
1846 : : !! OUTPUT
1847 : : !! exc(npts)=XC energy density
1848 : : !! vxc(npts,nspden)=derivative of the energy density wrt to the density
1849 : : !! [vxclrho(npts,nspden)]=derivative of the energy density wrt to the density laplacian
1850 : : !! [vxctau(npts,nspden)]=derivative of the energy density wrt to the kinetic energy density
1851 : : !! [dvxc(npts,ndvxc)]=2nd derivative of the energy density wrt to the density
1852 : : !! [vxcgr(npts,3)]=2nd derivative of the energy density wrt to the gradient
1853 : : !! 2nd derivative of the energy density wrt to the density and the gradient
1854 : : !! [d2vxc(npts,nd2vxc)]=3rd derivative of the energy density wrt to the density
1855 : : !!
1856 : : !! SIDE EFFECTS
1857 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
1858 : : !! Handle for XC functionals
1859 : : !!
1860 : : !! SOURCE
1861 : :
1862 : 1153158 : subroutine libxc_functionals_getvxc(ndvxc,nd2vxc,npts,nspden,order,rho,exc,vxc,&
1863 : 996790 : & grho2,vxcgr,lrho,vxclrho,tau,vxctau,dvxc,d2vxc,xc_functionals) ! Optional arguments
1864 : :
1865 : : !Arguments ------------------------------------
1866 : : integer, intent(in) :: ndvxc,nd2vxc,npts,nspden,order
1867 : : real(dp),intent(in) :: rho(npts,nspden)
1868 : : real(dp),intent(out) :: vxc(npts,nspden),exc(npts)
1869 : : real(dp),intent(in),optional :: grho2(npts,2*min(nspden,2)-1)
1870 : : real(dp),intent(out),optional :: vxcgr(npts,3)
1871 : : real(dp),intent(in),optional :: lrho(npts,nspden)
1872 : : real(dp),intent(out),optional :: vxclrho(npts,nspden)
1873 : : real(dp),intent(in),optional :: tau(npts,nspden)
1874 : : real(dp),intent(out),optional :: vxctau(npts,nspden)
1875 : : real(dp),intent(out),optional :: dvxc(npts,ndvxc)
1876 : : real(dp),intent(out),optional :: d2vxc(npts,nd2vxc)
1877 : : type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2)
1878 : : !Local variables -------------------------------
1879 : : !scalars
1880 : : integer :: ii,ipts
1881 : : logical :: is_gga,is_mgga,needs_tau,needs_laplacian,has_sigma_threshold
1882 : : real(dp),target :: exctmp
1883 : : character(len=500) :: msg
1884 : : real(dp) :: sigma_threshold_max
1885 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1886 : : type(C_PTR) :: rho_c,sigma_c,lrho_c,tau_c
1887 : : #endif
1888 : : !arrays
1889 : 768772 : real(dp),target :: rhotmp(nspden),sigma(3),vxctmp(nspden),vsigma(3)
1890 : : real(dp),target :: v2rho2(3),v2rhosigma(6),v2sigma2(6)
1891 : : real(dp),target :: v2rholapl(3),v2sigmalapl(6),v2lapl2(3)
1892 : : real(dp),target :: v2rhotau(3),v2sigmatau(6),v2lapltau(3),v2tau2(3)
1893 : : real(dp),target :: v3rho3(4),v3rho2sigma(9),v3rhosigma2(12),v3sigma3(10)
1894 : 768772 : real(dp),target :: lrhotmp(nspden),tautmp(nspden),vlrho(nspden),vtau(nspden)
1895 : 384386 : type(libxc_functional_type),pointer :: xc_funcs(:)
1896 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1897 : : type(C_PTR) :: exc_c(2),vxc_c(2),vsigma_c(2),vlrho_c(2),vtau_c(2)
1898 : : type(C_PTR) :: v2rho2_c(2),v2rhosigma_c(2),v2sigma2_c(2)
1899 : : type(C_PTR) :: v2rholapl_c(2),v2sigmalapl_c(2),v2lapl2_c(2)
1900 : : type(C_PTR) :: v2rhotau_c(2),v2sigmatau_c(2),v2lapltau_c(2),v2tau2_c(2)
1901 : : type(C_PTR) :: v3rho3_c(2),v3rho2sigma_c(2),v3rhosigma2_c(2),v3sigma3_c(2)
1902 : : #endif
1903 : :
1904 : : ! *************************************************************************
1905 : :
1906 [ - + ]: 384386 : if (.not.libxc_constants_initialized) call libxc_functionals_constants_load()
1907 : :
1908 : : !Select XC functional(s)
1909 [ + + ]: 384386 : if (present(xc_functionals)) then
1910 : 1207 : xc_funcs => xc_functionals
1911 : : else
1912 : 383179 : xc_funcs => xc_global
1913 : : end if
1914 : :
1915 [ - + ]: 384386 : is_gga =libxc_functionals_isgga (xc_funcs)
1916 [ - + ]: 384386 : is_mgga=libxc_functionals_ismgga(xc_funcs)
1917 [ + + - + : 617133 : needs_tau=(libxc_functionals_needs_tau(xc_funcs).and.present(tau))
- + ]
1918 [ + + - + : 733709 : needs_laplacian=(libxc_functionals_needs_laplacian(xc_funcs).and.present(lrho))
- + ]
1919 : :
1920 [ + - + + : 1537544 : sigma_threshold_max=maxval(xc_funcs(:)%sigma_threshold,mask=(xc_funcs(:)%id>0))
- + - - +
+ + - ]
1921 : 384386 : has_sigma_threshold=(sigma_threshold_max>zero)
1922 : :
1923 [ - + ]: 384386 : if (is_gga.and.(.not.present(grho2))) then
1924 : 0 : msg='GGA needs gradient of density!'
1925 : 0 : ABI_BUG(msg)
1926 : : end if
1927 [ + + ]: 384386 : if (is_mgga) then
1928 [ + - ]: 151639 : if (needs_tau) then
1929 [ - + ]: 151639 : if (present(vxctau).and.(.not.present(tau))) then
1930 : 0 : msg='meta-GGA needs tau!'
1931 : 0 : ABI_BUG(msg)
1932 : : end if
1933 : : end if
1934 [ + + ]: 151639 : if (needs_laplacian) then
1935 [ - + ]: 35063 : if (present(vxclrho).and.(.not.present(lrho))) then
1936 : 0 : msg='meta-GGA needs lrho!'
1937 : 0 : ABI_BUG(msg)
1938 : : end if
1939 : : end if
1940 : : endif
1941 : :
1942 : : !Inititalize all output arrays to zero
1943 [ + + + + : 1750087807 : exc=zero ; vxc=zero
+ + ]
1944 [ + + + + : 2073812456 : if (present(dvxc)) dvxc=zero
+ + ]
1945 [ + + + + : 387844 : if (present(d2vxc)) d2vxc=zero
+ + ]
1946 [ + + + - : 1792559126 : if ((is_gga.or.is_mgga).and.present(vxcgr)) vxcgr=zero
+ + + + ]
1947 [ + + + + : 54398531 : if (is_mgga.and.present(vxclrho)) vxclrho=zero
+ + ]
1948 [ + + + + : 250828923 : if (is_mgga.and.present(vxctau)) vxctau=zero
+ + ]
1949 : :
1950 : : !Determine which XC outputs can be computed
1951 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
1952 [ + + ]: 1153158 : do ii = 1,2
1953 [ + + ]: 768772 : if (xc_funcs(ii)%has_exc) then
1954 : 727249 : exc_c(ii)=c_loc(exctmp)
1955 : : else
1956 : 41523 : exc_c(ii)=C_NULL_PTR
1957 : : end if
1958 [ + + ]: 768772 : if (xc_funcs(ii)%has_vxc) then
1959 : 762312 : vxc_c(ii)=c_loc(vxctmp)
1960 : 762312 : vsigma_c(ii)=c_loc(vsigma)
1961 : 762312 : vtau_c(ii)=c_loc(vtau)
1962 : 762312 : vlrho_c(ii)=c_loc(vlrho)
1963 : : else
1964 : 6460 : vxc_c(ii)=C_NULL_PTR
1965 : 6460 : vsigma_c(ii)=c_NULL_PTR
1966 : 6460 : vtau_c(ii)=C_NULL_PTR
1967 : 6460 : vlrho_c(ii)=C_NULL_PTR
1968 : : end if
1969 [ + + + + ]: 768772 : if ((xc_funcs(ii)%has_fxc).and.(abs(order)>1)) then
1970 : 81965 : v2rho2_c(ii)=c_loc(v2rho2)
1971 : 81965 : v2sigma2_c(ii)=c_loc(v2sigma2)
1972 : 81965 : v2rhosigma_c(ii)=c_loc(v2rhosigma)
1973 [ + + ]: 81965 : if (is_mgga) then
1974 : 952 : v2rholapl_c(ii)=c_loc(v2rholapl)
1975 : 952 : v2sigmalapl_c(ii)=c_loc(v2sigmalapl)
1976 : 952 : v2lapl2_c(ii)=c_loc(v2lapl2)
1977 : 952 : v2rhotau_c(ii)=c_loc(v2rhotau)
1978 : 952 : v2sigmatau_c(ii)=c_loc(v2sigmatau)
1979 : 952 : v2lapltau_c(ii)=c_loc(v2lapltau)
1980 : 952 : v2tau2_c(ii)=c_loc(v2tau2)
1981 : : end if
1982 : : else
1983 : 686807 : v2rho2_c(ii)=C_NULL_PTR
1984 : 686807 : v2sigma2_c(ii)=C_NULL_PTR
1985 : 686807 : v2rhosigma_c(ii)=C_NULL_PTR
1986 [ + + ]: 686807 : if (is_mgga) then
1987 : 302326 : v2rholapl_c(ii)=C_NULL_PTR
1988 : 302326 : v2sigmalapl_c(ii)=C_NULL_PTR
1989 : 302326 : v2lapl2_c(ii)=C_NULL_PTR
1990 : 302326 : v2rhotau_c(ii)=C_NULL_PTR
1991 : 302326 : v2sigmatau_c(ii)=C_NULL_PTR
1992 : 302326 : v2lapltau_c(ii)=C_NULL_PTR
1993 : 302326 : v2tau2_c(ii)=C_NULL_PTR
1994 : : end if
1995 : : end if
1996 [ + + + + ]: 1153158 : if ((xc_funcs(ii)%has_kxc).and.(abs(order)>2)) then
1997 : 4 : v3rho3_c(ii)=c_loc(v3rho3)
1998 : 4 : v3sigma3_c(ii)=c_loc(v3sigma3)
1999 : 4 : v3rho2sigma_c(ii)=c_loc(v3rho2sigma)
2000 : 4 : v3rhosigma2_c(ii)=c_loc(v3rhosigma2)
2001 : : else
2002 : 768768 : v3rho3_c(ii)=C_NULL_PTR
2003 : 768768 : v3sigma3_c(ii)=C_NULL_PTR
2004 : 768768 : v3rho2sigma_c(ii)=C_NULL_PTR
2005 : 768768 : v3rhosigma2_c(ii)=C_NULL_PTR
2006 : : end if
2007 : : end do
2008 : : #endif
2009 : :
2010 : : !Initialize temporary arrays
2011 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2012 [ + + ]: 813168 : rhotmp=zero ; rho_c=c_loc(rhotmp)
2013 [ + + ]: 384386 : if (is_gga.or.is_mgga) then
2014 : 290234 : sigma=zero ; sigma_c=c_loc(sigma)
2015 : : end if
2016 [ + + ]: 290234 : if (is_mgga) then
2017 [ + + ]: 303278 : tautmp=zero ; tau_c=c_loc(tautmp)
2018 [ + + ]: 303278 : lrhotmp=zero ;lrho_c=c_loc(lrhotmp)
2019 : : end if
2020 : : #endif
2021 : :
2022 : : !Some mGGA functionals require a special treatment
2023 [ + + ]: 245791 : if (is_mgga) then
2024 : : !TB09 functional requires the c parameter to be set
2025 [ + - ]: 151639 : call libxc_functionals_compute_tb09(npts,nspden,rho,grho2,xc_funcs)
2026 : : end if
2027 : :
2028 : : !Loop over points
2029 [ + + ]: 831571980 : do ipts=1,npts
2030 : :
2031 : : ! Convert the quantities provided by ABINIT to the ones needed by libxc
2032 [ + + ]: 831187594 : if (nspden == 1) then
2033 : : ! ABINIT passes rho_up in the spin-unpolarized case, while the libxc
2034 : : ! expects the total density
2035 [ + + ]: 1488576286 : rhotmp(1:nspden) = two*rho(ipts,1:nspden)
2036 : : else
2037 [ + + ]: 260698353 : rhotmp(1:nspden) = rho(ipts,1:nspden)
2038 : : end if
2039 [ + + ]: 831187594 : if (is_gga.or.is_mgga) then
2040 [ + + ]: 597101346 : if (nspden==1) then
2041 : : ! ABINIT passes |grho_up|^2 while Libxc needs |grho_tot|^2
2042 : 522204572 : sigma(1) = four*grho2(ipts,1)
2043 : : else
2044 : : ! ABINIT passes |grho_up|^2, |grho_dn|^2, and |grho_tot|^2
2045 : : ! while Libxc needs |grho_up|^2, grho_up.grho_dn, and |grho_dn|^2
2046 : 74896774 : sigma(1) = grho2(ipts,1)
2047 : 74896774 : sigma(2) = (grho2(ipts,3) - grho2(ipts,1) - grho2(ipts,2))/two
2048 : 74896774 : sigma(3) = grho2(ipts,2)
2049 : : end if
2050 : : ! Apply a threshold on sigma (cannot be done in libxc6, at present)
2051 [ + + ]: 597101346 : if (has_sigma_threshold) then
2052 [ + + ]: 34856586 : do ii=1,2*nspden-1
2053 [ + + ]: 34856586 : if (abs(sigma(ii))<=sigma_threshold_max) sigma(ii)=sigma_threshold_max
2054 : : end do
2055 : : end if
2056 : : end if
2057 [ + + ]: 597101346 : if (is_mgga) then
2058 [ + - ]: 250292898 : if (nspden==1) then
2059 [ + - + + ]: 500585796 : if (needs_tau) tautmp(1:nspden) = two*tau(ipts,1:nspden)
2060 [ + + + + ]: 304271980 : if (needs_laplacian) lrhotmp(1:nspden) = two*lrho(ipts,1:nspden)
2061 : : else
2062 [ # # # # ]: 0 : if (needs_tau) tautmp(1:nspden) = tau(ipts,1:nspden)
2063 [ # # # # ]: 0 : if (needs_laplacian) lrhotmp(1:nspden) = lrho(ipts,1:nspden)
2064 : : end if
2065 : : end if
2066 : :
2067 : : ! Loop over functionals
2068 [ + + ]: 2493947168 : do ii = 1,2
2069 [ + + ]: 1662375188 : if (xc_funcs(ii)%id<=0) cycle
2070 : :
2071 : : ! Get the energy and the potential (and possibly the other derivatives)
2072 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2073 [ + + ]: 3452002545 : exctmp=zero ; vxctmp=zero
2074 : : ! ===== LDA =====
2075 [ + + ]: 1643306359 : if (xc_funcs(ii)%family==XC_FAMILY_LDA) then
2076 [ + + ]: 1064366968 : exctmp=zero ; vxctmp=zero ; v2rho2=zero ; v3rho3=zero
2077 : : call xc_get_lda(xc_funcs(ii)%conf,1,rho_c, &
2078 : 520303807 : & exc_c(ii),vxc_c(ii),v2rho2_c(ii),v3rho3_c(ii))
2079 : : ! ===== GGA =====
2080 [ + + + + ]: 1123002552 : else if (xc_funcs(ii)%family==XC_FAMILY_GGA.or. &
2081 : : & xc_funcs(ii)%family==XC_FAMILY_HYB_GGA) then
2082 [ + + ]: 1494422149 : exctmp=zero ; vxctmp=zero ; vsigma=zero
2083 : 676395838 : v2rho2=zero ; v2sigma2=zero ; v2rhosigma=zero
2084 : 676395838 : v3rho3=zero ; v3rho2sigma=zero ; v3rhosigma2=zero ; v3sigma3=zero
2085 : : call xc_get_gga(xc_funcs(ii)%conf,1,rho_c,sigma_c, &
2086 : : & exc_c(ii),vxc_c(ii),vsigma_c(ii), &
2087 : : & v2rho2_c(ii),v2rhosigma_c(ii),v2sigma2_c(ii), &
2088 : 676395838 : & v3rho3_c(ii),v3rho2sigma_c(ii),v3rhosigma2_c(ii),v3sigma3_c(ii))
2089 : : ! ===== mGGA =====
2090 [ - + - - ]: 446606714 : else if (xc_funcs(ii)%family==XC_FAMILY_MGGA.or. &
2091 : : & xc_funcs(ii)%family==XC_FAMILY_HYB_MGGA) then
2092 [ + + + + : 1786426856 : exctmp=zero ; vxctmp=zero ; vsigma=zero ; vlrho=zero ; vtau=zero
+ + ]
2093 : 446606714 : v2rho2=zero ; v2sigma2=zero ; v2rhosigma=zero
2094 : : ! At present, we don't use 2nd derivatives involving Tau or Laplacian
2095 : : call xc_get_mgga(xc_funcs(ii)%conf,1,rho_c,sigma_c,lrho_c,tau_c, &
2096 : : & exc_c(ii),vxc_c(ii),vsigma_c(ii),vlrho_c(ii),vtau_c(ii), &
2097 : : & v2rho2_c(ii),v2rhosigma_c(ii),v2rholapl_c(ii),v2rhotau_c(ii),v2sigma2_c(ii), &
2098 : 446606714 : & v2sigmalapl_c(ii),v2sigmatau_c(ii),v2lapl2_c(ii),v2lapltau_c(ii),v2tau2_c(ii))
2099 : : end if
2100 : : #endif
2101 : :
2102 : 1643306359 : exc(ipts) = exc(ipts) + exctmp
2103 [ + + ]: 3452002545 : vxc(ipts,1:nspden) = vxc(ipts,1:nspden) + vxctmp(1:nspden)
2104 : :
2105 : : ! Deal with fxc and kxc
2106 [ + + ]: 1643306359 : if (abs(order)>1) then
2107 : : ! ----- LDA -----
2108 [ + + ]: 356529150 : if (xc_funcs(ii)%family==XC_FAMILY_LDA) then
2109 [ + + ]: 110432248 : if (nspden==1) then
2110 [ + - ]: 110390264 : if(order>=2) then
2111 : 110390264 : dvxc(ipts,1)=dvxc(ipts,1)+v2rho2(1)
2112 [ + + ]: 110390264 : if(order>2) then
2113 : 6912 : d2vxc(ipts,1)=d2vxc(ipts,1)+v3rho3(1)
2114 : : endif
2115 [ # # ]: 0 : else if (order==-2) then
2116 : 0 : dvxc(ipts,1)=dvxc(ipts,1)+v2rho2(1)
2117 : 0 : dvxc(ipts,2)=dvxc(ipts,2)+v2rho2(1)
2118 : : endif
2119 : : else
2120 : 41984 : dvxc(ipts,1)=dvxc(ipts,1)+v2rho2(1)
2121 : 41984 : dvxc(ipts,2)=dvxc(ipts,2)+v2rho2(2)
2122 : 41984 : dvxc(ipts,3)=dvxc(ipts,3)+v2rho2(3)
2123 [ - + ]: 41984 : if(abs(order)>2) then
2124 : 0 : d2vxc(ipts,1)=d2vxc(ipts,1)+v3rho3(1)
2125 : 0 : d2vxc(ipts,2)=d2vxc(ipts,2)+v3rho3(2)
2126 : 0 : d2vxc(ipts,3)=d2vxc(ipts,3)+v3rho3(3)
2127 : 0 : d2vxc(ipts,4)=d2vxc(ipts,4)+v3rho3(4)
2128 : : endif
2129 : : endif
2130 : : ! ----- GGA or mGGA -----
2131 : : else if (xc_funcs(ii)%family==XC_FAMILY_GGA.or. &
2132 : : & xc_funcs(ii)%family==XC_FAMILY_HYB_GGA.or. &
2133 [ + + + + : 246096902 : & xc_funcs(ii)%family==XC_FAMILY_MGGA.or. &
- + - - ]
2134 : : & xc_funcs(ii)%family==XC_FAMILY_HYB_MGGA) then
2135 [ + + ]: 246096902 : if (xc_funcs(ii)%kind==XC_EXCHANGE) then
2136 [ + + ]: 118944914 : if (nspden==1) then
2137 : 92554012 : dvxc(ipts,1)=v2rho2(1)*two
2138 : 92554012 : dvxc(ipts,2)=dvxc(ipts,1)
2139 : 92554012 : dvxc(ipts,3)=two*two*vsigma(1)
2140 : 92554012 : dvxc(ipts,4)=dvxc(ipts,3)
2141 : 92554012 : dvxc(ipts,5)=four*two*v2rhosigma(1)
2142 : 92554012 : dvxc(ipts,6)=dvxc(ipts,5)
2143 : 92554012 : dvxc(ipts,7)=two*four*four*v2sigma2(1)
2144 : 92554012 : dvxc(ipts,8)=dvxc(ipts,7)
2145 : : else
2146 : 26390902 : dvxc(ipts,1)=v2rho2(1)
2147 : 26390902 : dvxc(ipts,2)=v2rho2(3)
2148 : 26390902 : dvxc(ipts,3)=two*vsigma(1)
2149 : 26390902 : dvxc(ipts,4)=two*vsigma(3)
2150 : 26390902 : dvxc(ipts,5)=two*v2rhosigma(1)
2151 : 26390902 : dvxc(ipts,6)=two*v2rhosigma(6)
2152 : 26390902 : dvxc(ipts,7)=four*v2sigma2(1)
2153 : 26390902 : dvxc(ipts,8)=four*v2sigma2(6)
2154 : : end if
2155 [ + + ]: 127151988 : else if (xc_funcs(ii)%kind==XC_CORRELATION) then
2156 [ + + ]: 118944914 : if (nspden==1) then
2157 : 92554012 : dvxc(ipts,9)=v2rho2(1)
2158 : 92554012 : dvxc(ipts,10)=dvxc(ipts,9)
2159 : 92554012 : dvxc(ipts,11)=dvxc(ipts,9)
2160 : 92554012 : dvxc(ipts,12)=two*vsigma(1)
2161 : 92554012 : dvxc(ipts,13)=two*v2rhosigma(1)
2162 : 92554012 : dvxc(ipts,14)=dvxc(ipts,13)
2163 : 92554012 : dvxc(ipts,15)=four*v2sigma2(1)
2164 : : else
2165 : 26390902 : dvxc(ipts,9)=v2rho2(1)
2166 : 26390902 : dvxc(ipts,10)=v2rho2(2)
2167 : 26390902 : dvxc(ipts,11)=v2rho2(3)
2168 : 26390902 : dvxc(ipts,12)=two*vsigma(1)
2169 : 26390902 : dvxc(ipts,13)=two*v2rhosigma(1)
2170 : 26390902 : dvxc(ipts,14)=two*v2rhosigma(6)
2171 : 26390902 : dvxc(ipts,15)=four*v2sigma2(1)
2172 : : end if
2173 : : end if
2174 : : end if
2175 : : end if
2176 : :
2177 : : ! Convert the quantities returned by Libxc to the ones needed by ABINIT
2178 [ + + + - ]: 1643306359 : if ((is_gga.or.is_mgga).and.present(vxcgr)) then
2179 [ + + ]: 1176981634 : if (nspden==1) then
2180 : 1035351161 : vxcgr(ipts,3) = vxcgr(ipts,3) + vsigma(1)*two
2181 : : else
2182 : 141630473 : vxcgr(ipts,1) = vxcgr(ipts,1) + two*vsigma(1) - vsigma(2)
2183 : 141630473 : vxcgr(ipts,2) = vxcgr(ipts,2) + two*vsigma(3) - vsigma(2)
2184 : 141630473 : vxcgr(ipts,3) = vxcgr(ipts,3) + vsigma(2)
2185 : : end if
2186 : : end if
2187 [ + + + - ]: 1176981634 : if (is_mgga.and.needs_tau.and.present(vxctau)) then
2188 [ + + ]: 1001171592 : vxctau(ipts,1:nspden) = vxctau(ipts,1:nspden) + vtau(1:nspden)
2189 : : end if
2190 [ + + + - ]: 2474493953 : if (is_mgga.and.needs_laplacian.and.present(vxclrho)) then
2191 [ + + ]: 215916328 : vxclrho(ipts,1:nspden) = vxclrho(ipts,1:nspden) + vlrho(1:nspden)
2192 : : end if
2193 : :
2194 : : end do ! ii
2195 : : end do ! ipts
2196 : :
2197 [ + + + + : 1090795 : end subroutine libxc_functionals_getvxc
+ + + + +
+ + + + +
+ + ]
2198 : : !!***
2199 : :
2200 : : !======================================================================
2201 : : ! HEREAFTER ARE PRIVATE FUNCTIONS
2202 : : !======================================================================
2203 : :
2204 : : !----------------------------------------------------------------------
2205 : :
2206 : : !!****f* libxc_functionals/libxc_functionals_compute_tb09
2207 : : !! NAME
2208 : : !! libxc_functionals_compute_tb09
2209 : : !!
2210 : : !! FUNCTION
2211 : : !! Compute c parameter for Tran-Blaha 2009 functional and set it
2212 : : !! Applies on a (set of) functional(s)
2213 : : !!
2214 : : !! INPUTS
2215 : : !! npts=number of of points for the density
2216 : : !! nspden=number of spin-density components
2217 : : !! rho(npts,nspden)=electronic density
2218 : : !! grho2(npts,nspden)=squared gradient of the density
2219 : : !!
2220 : : !! OUTPUT
2221 : : !!
2222 : : !! SIDE EFFECTS
2223 : : !! [xc_functionals(2)]=<type(libxc_functional_type)>, optional argument
2224 : : !! Handle for XC functionals
2225 : : !!
2226 : : !! SOURCE
2227 : :
2228 : 151639 : subroutine libxc_functionals_compute_tb09(npts,nspden,rho,grho2,xc_functionals)
2229 : :
2230 : : !Arguments ------------------------------------
2231 : : integer, intent(in) :: npts,nspden
2232 : : real(dp),intent(in) :: rho(npts,nspden),grho2(npts,2*min(nspden,2)-1)
2233 : : type(libxc_functional_type),intent(inout),optional,target :: xc_functionals(2)
2234 : : !Local variables -------------------------------
2235 : : !scalars
2236 : : integer :: ii,ipts
2237 : : logical :: fixed_c_tb09,is_mgga_tb09
2238 : : real(dp) :: cc
2239 : : !arrays
2240 : 151639 : type(libxc_functional_type),pointer :: xc_funcs(:)
2241 : 151639 : real(dp),allocatable :: gnon(:)
2242 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2243 : : integer(C_INT) :: npar_c=int(2,kind=C_INT)
2244 : : real(C_DOUBLE) :: param_c(2)
2245 : : #endif
2246 : :
2247 : : ! *************************************************************************
2248 : :
2249 : 0 : if (.not.libxc_constants_initialized) call libxc_functionals_constants_load()
2250 : :
2251 : : !Select XC functional(s)
2252 [ + - ]: 151639 : if (present(xc_functionals)) then
2253 : 151639 : xc_funcs => xc_functionals
2254 : : else
2255 : 151639 : xc_funcs => xc_global
2256 : : end if
2257 : :
2258 [ + + + + ]: 384908 : is_mgga_tb09=(any(xc_funcs%id==libxc_functionals_getid('XC_MGGA_X_TB09')))
2259 [ + + + + ]: 384912 : fixed_c_tb09=(any(abs(xc_funcs%xc_tb09_c-99.99_dp)>tol12))
2260 : :
2261 [ + + ]: 151639 : if (is_mgga_tb09) then
2262 : :
2263 : : ! C is fixed by the user
2264 [ + + ]: 35028 : if (fixed_c_tb09) then
2265 : : cc=zero
2266 [ + + ]: 105078 : do ii=1,2
2267 [ + + ]: 105078 : if (abs(xc_funcs(ii)%xc_tb09_c-99.99_dp)>tol12) cc=xc_funcs(ii)%xc_tb09_c
2268 : : end do
2269 : : ! write(msg,'(2a,f9.6)' ) ch10,&
2270 : : !& 'In the mGGA functional TB09, c is fixed by the user and is equal to ',cc
2271 : : !call wrtout(std_out,msg,'COLL')
2272 : : ! C is computed
2273 : : else
2274 [ - + + - : 6 : ABI_MALLOC(gnon,(npts))
+ - + - -
+ - + ]
2275 [ + + ]: 4004 : do ipts=1,npts
2276 [ + + + + ]: 8006 : if (sum(rho(ipts,:))<=1e-7_dp) then
2277 : 1056 : gnon(ipts)=zero
2278 : : else
2279 [ + - ]: 2946 : if (nspden==1) then
2280 : 2946 : gnon(ipts)=sqrt(grho2(ipts,1))/rho(ipts,1)
2281 : : else
2282 [ # # ]: 0 : gnon(ipts)=sqrt(grho2(ipts,3))/sum(rho(ipts,:))
2283 : : end if
2284 : : end if
2285 : : end do
2286 [ + + ]: 4004 : cc= -0.012_dp + 1.023_dp*sqrt(sum(gnon)/npts)
2287 [ - + ]: 2 : ABI_FREE(gnon)
2288 : : ! write(msg,'(2a,f9.6)' ) ch10,'In the mGGA functional TB09, c = ',cc
2289 : : ! call wrtout(std_out,msg,'COLL')
2290 : : end if
2291 : :
2292 : : ! Set c in XC data structure
2293 [ + + ]: 105084 : do ii=1,2
2294 [ + + ]: 105084 : if (xc_funcs(ii)%id==libxc_functionals_getid('XC_MGGA_X_TB09')) then
2295 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2296 : 35028 : param_c(1)=real(cc,kind=C_DOUBLE) ; param_c(2)=real(0._dp,kind=C_DOUBLE)
2297 : 35028 : call xc_func_set_params(xc_funcs(ii)%conf,param_c,npar_c)
2298 : : #endif
2299 : : end if
2300 : : end do
2301 : : end if
2302 : :
2303 [ - + ]: 151639 : end subroutine libxc_functionals_compute_tb09
2304 : : !!***
2305 : :
2306 : : !----------------------------------------------------------------------
2307 : :
2308 : : !!****f* libxc_functionals/libxc_functionals_getrefs
2309 : : !! NAME
2310 : : !! libxc_functionals_getrefs
2311 : : !!
2312 : : !! FUNCTION
2313 : : !! Return the reference(s) of a single XC functional
2314 : : !!
2315 : : !! INPUTS
2316 : : !! xc_functional=<type(libxc_functional_type)>, handle for XC functional
2317 : : !!
2318 : : !! OUTPUT
2319 : : !! xcrefs(:)= references(s) of the functional
2320 : : !!
2321 : : !! SOURCE
2322 : :
2323 : : subroutine libxc_functionals_getrefs(xcrefs,xc_functional)
2324 : :
2325 : : !Arguments ------------------------------------
2326 : : character(len=*),intent(out) :: xcrefs(:)
2327 : : type(libxc_functional_type),intent(in) :: xc_functional
2328 : : !Local variables-------------------------------
2329 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2330 : : integer(C_INT) :: iref_c
2331 : : character(kind=C_CHAR,len=1),pointer :: strg_c
2332 : : #endif
2333 : :
2334 : : ! *************************************************************************
2335 : :
2336 : : xcrefs(:)=''
2337 : :
2338 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2339 : : iref_c=0
2340 : : do while (iref_c>=0.and.iref_c<size(xcrefs))
2341 : : call c_f_pointer(xc_get_info_refs(xc_functional%conf,iref_c),strg_c)
2342 : : if (associated(strg_c)) then
2343 : : call xc_char_to_f(strg_c,xcrefs(iref_c+1))
2344 : : iref_c=iref_c+1
2345 : : else
2346 : : iref_c=-1
2347 : : end if
2348 : : end do
2349 : : #else
2350 : : if (.False.) write(std_out,*) xc_functional%id
2351 : : #endif
2352 : :
2353 : : end subroutine libxc_functionals_getrefs
2354 : : !!***
2355 : :
2356 : : !----------------------------------------------------------------------
2357 : :
2358 : : !!****f* libxc_functionals/libxc_functionals_depends_on_temp
2359 : : !! NAME
2360 : : !! libxc_functionals_depends_on_temp
2361 : : !!
2362 : : !! FUNCTION
2363 : : !! Test function to identify whether a single XC functional
2364 : : !! depends on the electronic temperature or not
2365 : : !!
2366 : : !! INPUTS
2367 : : !! xc_functional=<type(libxc_functional_type)>, handle for XC functional
2368 : : !!
2369 : : !! SOURCE
2370 : :
2371 : 2296 : function libxc_functionals_depends_on_temp(xc_functional)
2372 : :
2373 : : !Arguments ------------------------------------
2374 : : logical :: libxc_functionals_depends_on_temp
2375 : : type(libxc_functional_type),intent(in) :: xc_functional
2376 : : !Local variables-------------------------------
2377 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2378 : : integer(C_INT) :: ipar_c
2379 : : character(len=50) :: par_name
2380 : : character(kind=C_CHAR,len=1),pointer :: strg_c
2381 : : #endif
2382 : :
2383 : : ! *************************************************************************
2384 : :
2385 : 2296 : libxc_functionals_depends_on_temp = .false.
2386 : :
2387 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2388 : 2296 : ipar_c=0
2389 [ + + ]: 18782 : do while (ipar_c>=0)
2390 : 16493 : call c_f_pointer(xc_func_get_params_name(xc_functional%conf,ipar_c),strg_c)
2391 [ + + ]: 18782 : if (associated(strg_c)) then
2392 : 14204 : call xc_char_to_f(strg_c,par_name)
2393 [ + + ]: 14204 : if (trim(par_name)=="T") then
2394 : : libxc_functionals_depends_on_temp=.true. ; exit
2395 : : end if
2396 : 14197 : ipar_c=ipar_c+1
2397 : : else
2398 : 2289 : ipar_c=-1
2399 : : end if
2400 : : end do
2401 : :
2402 [ + + ]: 2296 : if (.not.libxc_functionals_depends_on_temp) then
2403 : : ! For libXC_version<5, these three functional were T-dependent
2404 : : libxc_functionals_depends_on_temp = &
2405 : : & (xc_functional%id==libxc_functionals_getid('XC_LDA_XC_KSDT') .or. &
2406 : : & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_GDSMFB') .or. &
2407 [ - + - + : 2289 : & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_CORRKSDT'))
- + ]
2408 : : end if
2409 : :
2410 : : #else
2411 : : if (.False.) write(std_out,*) xc_functional%id
2412 : : #endif
2413 : :
2414 : 2296 : end function libxc_functionals_depends_on_temp
2415 : : !!***
2416 : :
2417 : : !----------------------------------------------------------------------
2418 : :
2419 : : !!****f* libxc_functionals/libxc_functionals_set_temp
2420 : : !! NAME
2421 : : !! libxc_functionals_set_temp
2422 : : !!
2423 : : !! FUNCTION
2424 : : !! Set the electronic temperature in a single XC functional
2425 : : !! No action if functional doesnt depend on temperature
2426 : : !!
2427 : : !! INPUTS
2428 : : !! xc_functional=<type(libxc_functional_type)>, handle for XC functional
2429 : : !! temperature=electronic temperature (in Ha units, i.e. T_kelvin * k_B_in_Ha/K )
2430 : : !!
2431 : : !! SOURCE
2432 : :
2433 : 7 : subroutine libxc_functionals_set_temp(xc_functional,temperature)
2434 : :
2435 : : !Arguments ------------------------------------
2436 : : real(dp),intent(in) :: temperature
2437 : : type(libxc_functional_type),intent(in) :: xc_functional
2438 : : !Local variables-------------------------------
2439 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2440 : : integer(C_INT) :: iset_c,npar_c
2441 : : real(C_DOUBLE) :: temp_c,param_c(1)
2442 : : character(len=50) :: par_name
2443 : : character(kind=C_CHAR,len=1),target :: name_c(2)
2444 : : #endif
2445 : :
2446 : : ! *************************************************************************
2447 : :
2448 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2449 [ + - ]: 7 : if (xc_functional%temperature>zero) then
2450 : :
2451 : 7 : par_name="T" ; name_c=xc_char_to_c(trim(par_name))
2452 : 7 : temp_c=real(temperature,kind=C_DOUBLE)
2453 : 7 : iset_c = xc_func_set_params_name(xc_functional%conf,c_loc(name_c),temp_c)
2454 [ - + ]: 7 : if (iset_c /= 0) then
2455 : : !Try this when set_params_name method is not available (libXC<5)
2456 : : if (xc_functional%id==libxc_functionals_getid('XC_LDA_XC_KSDT') .or. &
2457 [ # # # # : 0 : & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_GDSMFB') .or. &
# # ]
2458 : : & xc_functional%id==libxc_functionals_getid('XC_LDA_XC_CORRKSDT')) then
2459 : 0 : param_c(1)=real(zero,kind=C_DOUBLE);npar_c=int(1,kind=C_INT)
2460 : 0 : call xc_func_set_params(xc_functional%conf,param_c,npar_c)
2461 : : end if
2462 : : end if
2463 : :
2464 : : end if
2465 : :
2466 : : #else
2467 : : if (.False.) write(std_out,*) xc_functional%id
2468 : : #endif
2469 : :
2470 : 7 : end subroutine libxc_functionals_set_temp
2471 : : !!***
2472 : :
2473 : : !----------------------------------------------------------------------
2474 : :
2475 : : !!****f* libxc_functionals/libxc_functionals_constants_load
2476 : : !! NAME
2477 : : !! libxc_functionals_constants_load
2478 : : !!
2479 : : !! FUNCTION
2480 : : !! Load libXC constants from C headers
2481 : : !!
2482 : : !! SOURCE
2483 : :
2484 : 303 : subroutine libxc_functionals_constants_load()
2485 : :
2486 : : !Local variables-------------------------------
2487 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2488 : : integer(C_INT) :: i1,i2,i3,i4,i5,i6,i7,i8,i9
2489 : : #endif
2490 : :
2491 : : ! *************************************************************************
2492 : :
2493 : : #if defined HAVE_LIBXC && defined HAVE_FC_ISO_C_BINDING
2494 : 303 : call xc_get_singleprecision_constant(i1)
2495 : 303 : XC_SINGLE_PRECISION = int(i1)
2496 : 303 : call xc_get_family_constants(i1,i2,i3,i4,i5,i6,i7,i8,i9)
2497 : 303 : XC_FAMILY_UNKNOWN = int(i1)
2498 : 303 : XC_FAMILY_LDA = int(i2)
2499 : 303 : XC_FAMILY_GGA = int(i3)
2500 : 303 : XC_FAMILY_MGGA = int(i4)
2501 : 303 : XC_FAMILY_LCA = int(i5)
2502 : 303 : XC_FAMILY_OEP = int(i6)
2503 : 303 : XC_FAMILY_HYB_GGA = int(i7)
2504 : 303 : XC_FAMILY_HYB_MGGA = int(i8)
2505 : 303 : XC_FAMILY_HYB_LDA = int(i9)
2506 : 303 : call xc_get_flags_constants(i1,i2,i3,i4,i5,i6,i7,i8)
2507 : 303 : XC_FLAGS_HAVE_EXC = int(i1)
2508 : 303 : XC_FLAGS_HAVE_VXC = int(i2)
2509 : 303 : XC_FLAGS_HAVE_FXC = int(i3)
2510 : 303 : XC_FLAGS_HAVE_KXC = int(i4)
2511 : 303 : XC_FLAGS_HAVE_LXC = int(i5)
2512 : 303 : XC_FLAGS_NEEDS_TAU = int(i6)
2513 : 303 : XC_FLAGS_NEEDS_LAPLACIAN= int(i7)
2514 : 303 : XC_FLAGS_ENFORCE_FHC = int(i8)
2515 : 303 : call xc_get_kind_constants(i1,i2,i3,i4)
2516 : 303 : XC_EXCHANGE = int(i1)
2517 : 303 : XC_CORRELATION = int(i2)
2518 : 303 : XC_EXCHANGE_CORRELATION = int(i3)
2519 : 303 : XC_KINETIC = int(i4)
2520 : 303 : libxc_constants_initialized=.true.
2521 : : #endif
2522 : :
2523 : 303 : end subroutine libxc_functionals_constants_load
2524 : : !!***
2525 : :
2526 : : !----------------------------------------------------------------------
2527 : :
2528 : : !!****f* libxc_functionals/xc_char_to_c
2529 : : !! NAME
2530 : : !! xc_char_to_c
2531 : : !!
2532 : : !! FUNCTION
2533 : : !! Helper function to convert a Fortran string to a C string
2534 : : !! Based on a routine by Joseph M. Krahn
2535 : : !!
2536 : : !! INPUTS
2537 : : !! f_string=Fortran string
2538 : : !!
2539 : : !! OUTPUT
2540 : : !! c_string=C string
2541 : : !!
2542 : : !! SOURCE
2543 : :
2544 : : #if defined HAVE_FC_ISO_C_BINDING
2545 [ - + ]: 327312 : function xc_char_to_c(f_string) result(c_string)
2546 : :
2547 : : !Arguments ------------------------------------
2548 : : character(len=*),intent(in) :: f_string
2549 : : character(kind=C_CHAR,len=1) :: c_string(len_trim(f_string)+1)
2550 : : !Local variables -------------------------------
2551 : : integer :: ii,strlen
2552 : :
2553 : : !! *************************************************************************
2554 : :
2555 : 327312 : strlen=len_trim(f_string)
2556 [ + + ]: 3970208 : forall(ii=1:strlen)
2557 : : c_string(ii)=f_string(ii:ii)
2558 : : end forall
2559 : 327312 : c_string(strlen+1)=C_NULL_CHAR
2560 : 327312 : end function xc_char_to_c
2561 : : #endif
2562 : : !!***
2563 : :
2564 : : !----------------------------------------------------------------------
2565 : :
2566 : : !!****f* libxc_functionals/xc_char_to_f
2567 : : !! NAME
2568 : : !! xc_char_to_f
2569 : : !!
2570 : : !! FUNCTION
2571 : : !! Helper function to convert a C string to a Fortran string
2572 : : !! Based on a routine by Joseph M. Krahn
2573 : : !!
2574 : : !! NOTES
2575 : : !! non-ascii chars are replaced by "?" as outputting strings containing non-ascii entries
2576 : : !! can lead to IO error with ifort when running in parallel (don't know why sequential execution is OK, though)
2577 : : !!
2578 : : !! forrtl: severe (38): error during write, unit 6, file /proc/3478/fd/1
2579 : : !! Image PC Routine Line Source
2580 : : !! libifcoremt.so.5 00007FEA9BA95F46 for__io_return Unknown Unknown
2581 : : !! libifcoremt.so.5 00007FEA9BB03A99 for_write_seq_fmt Unknown Unknown
2582 : : !! libifcoremt.so.5 00007FEA9BB0193A for_write_seq_fmt Unknown Unknown
2583 : : !! abinit 000000000285EB7A m_io_tools_mp_wri 1218 m_io_tools.F90
2584 : : !!
2585 : : !! INPUTS
2586 : : !! c_string=C string
2587 : : !!
2588 : : !! OUTPUT
2589 : : !! f_string=Fortran string
2590 : : !!
2591 : : !! SOURCE
2592 : :
2593 : : #if defined HAVE_FC_ISO_C_BINDING
2594 : 35989 : subroutine xc_char_to_f(c_string,f_string)
2595 : :
2596 : : !Arguments ------------------------------------
2597 : : character(kind=C_CHAR,len=1),intent(in) :: c_string(*)
2598 : : character(len=*),intent(out) :: f_string
2599 : : !Local variables -------------------------------
2600 : : integer :: ii
2601 : :
2602 : : !! *************************************************************************
2603 : :
2604 : 35989 : ii=1
2605 [ + + - + ]: 1212225 : do while(c_string(ii)/=C_NULL_CHAR.and.ii<=len(f_string))
2606 [ + + ]: 1176236 : if (iachar(c_string(ii)) <= 127) then
2607 : 1176092 : f_string(ii:ii)=c_string(ii)
2608 : : else
2609 : 144 : f_string(ii:ii)="?"
2610 : : end if
2611 : 1176236 : ii=ii+1
2612 : : end do
2613 [ + - + - ]: 35989 : if (ii<len(f_string)) f_string(ii:)=' '
2614 : 35989 : end subroutine xc_char_to_f
2615 : : #endif
2616 : : !!***
2617 : :
2618 : : !----------------------------------------------------------------------
2619 : :
2620 : 0 : end module libxc_functionals
2621 : : !!***
|
