34 use,
intrinsic :: iso_fortran_env
54 use xc_functional_oct_m
69 xc_is_orbital_dependent, &
70 xc_is_not_size_consistent, &
71 xc_is_energy_functional, &
73 family_is_mgga_with_exc, &
78 type internal_quantities_t
79 real(real64),
pointer :: rho(:,:)
81 real(real64),
allocatable :: dens(:,:)
82 real(real64),
allocatable :: gdens(:,:,:)
83 real(real64),
allocatable :: ldens(:,:)
84 real(real64),
allocatable :: tau(:,:)
85 end type internal_quantities_t
90 integer,
public :: family
91 integer,
public :: flags
92 integer,
public :: kernel_family
93 type(xc_functional_t),
public :: functional(2,2)
96 type(xc_functional_t),
public :: kernel(2,2)
97 real(real64),
public :: kernel_lrc_alpha
99 real(real64),
public :: cam_omega
100 real(real64),
public :: cam_alpha
101 real(real64),
public :: cam_beta
102 real(real64),
public :: cam_ext(3)
104 logical :: use_gi_ked
106 integer :: xc_density_correction
107 logical :: xcd_optimize_cutoff
108 real(real64) :: xcd_ncutoff
109 logical :: xcd_minimum
110 logical :: xcd_normalize
113 type(internal_quantities_t) :: quantities
116 real(real64),
parameter :: tiny = 1.0e-12_real64
118 integer,
parameter :: &
125 subroutine xc_write_info(xcs, iunit, namespace)
126 type(xc_t),
intent(in) :: xcs
127 integer,
optional,
intent(in) :: iunit
128 type(namespace_t),
optional,
intent(in) :: namespace
132 push_sub(xc_write_info)
134 write(
message(1),
'(a)')
"Exchange-correlation:"
138 call xc_functional_write_info(xcs%functional(ifunc, 1), iunit, namespace)
141 if (abs(xcs%cam_alpha + xcs%cam_beta) >
m_epsilon)
then
143 write(
message(2),
'(a,f8.5)')
"Exact exchange mixing = ", xcs%cam_alpha
144 write(
message(3),
'(a,f8.5)')
"Exact exchange for short-range beta = ", xcs%cam_beta
145 write(
message(4),
'(a,f8.5)')
"Exact exchange range-separate omega = ", xcs%cam_omega
150 pop_sub(xc_write_info)
151 end subroutine xc_write_info
155 subroutine xc_init(xcs, namespace, ndim, periodic_dim, nel, x_id, c_id, xk_id, ck_id, hartree_fock, ispin)
156 type(xc_t),
intent(out) :: xcs
157 type(namespace_t),
intent(in) :: namespace
158 integer,
intent(in) :: ndim
159 integer,
intent(in) :: periodic_dim
160 real(real64),
intent(in) :: nel
161 integer,
intent(in) :: x_id
162 integer,
intent(in) :: c_id
163 integer,
intent(in) :: xk_id
164 integer,
intent(in) :: ck_id
165 logical,
intent(in) :: hartree_fock
166 integer,
intent(in) :: ispin
168 integer :: isp, xc_major, xc_minor, xc_micro
174 call xc_f03_version(xc_major, xc_minor, xc_micro)
178 xcs%kernel_family = 0
188 call xc_functional_init(xcs%functional(
func_x, isp), namespace, x_id, ndim, nel, isp)
189 call xc_functional_init(xcs%functional(
func_c, isp), namespace, c_id, ndim, nel, isp)
191 call xc_functional_init(xcs%kernel(
func_x, isp), namespace, xk_id, ndim, nel, isp)
192 call xc_functional_init(xcs%kernel(
func_c, isp), namespace, ck_id, ndim, nel, isp)
196 xcs%family = ior(xcs%family, xcs%functional(
func_x,1)%family)
197 xcs%family = ior(xcs%family, xcs%functional(
func_c,1)%family)
199 xcs%flags = ior(xcs%flags, xcs%functional(
func_x,1)%flags)
200 xcs%flags = ior(xcs%flags, xcs%functional(
func_c,1)%flags)
202 xcs%kernel_family = ior(xcs%kernel_family, xcs%kernel(
func_x,1)%family)
203 xcs%kernel_family = ior(xcs%kernel_family, xcs%kernel(
func_c,1)%family)
206 if (xc_is_not_size_consistent(xcs, namespace) .and. periodic_dim > 0)
then
207 message(1) =
"Cannot perform a periodic calculation with a functional"
208 message(2) =
"that depends on the number of electrons."
217 ll = (hartree_fock) &
218 .or.(xcs%functional(
func_x,1)%id == xc_oep_x) &
219 .or. family_is_hybrid(xcs)
221 if ((xcs%functional(
func_x,1)%id /= 0).and.(xcs%functional(
func_x,1)%id /= xc_oep_x))
then
222 message(1) =
"You cannot use an exchange functional when performing"
223 message(2) =
"a Hartree-Fock calculation or using a hybrid functional."
227 if (periodic_dim == ndim)
then
228 call messages_experimental(
"Fock operator (Hartree-Fock, OEP, hybrids) in fully periodic systems", namespace=namespace)
232 if (family_is_hybrid(xcs))
then
233 if( any(abs(xcs%cam_ext) >
m_epsilon) )
call set_hybrid_params(xcs,namespace)
235 call xc_f03_hyb_cam_coef(xcs%functional(
func_c,1)%conf, xcs%cam_omega, &
236 xcs%cam_alpha, xcs%cam_beta)
237 call xc_f03_hyb_cam_coef(xcs%functional(
func_c,2)%conf, xcs%cam_omega, &
238 xcs%cam_alpha, xcs%cam_beta)
242 xcs%cam_alpha =
m_one
247 xcs%functional(
func_x,1)%family = xc_family_oep
248 xcs%functional(
func_x,1)%id = xc_oep_x
249 xcs%functional(
func_x,2)%family = xc_family_oep
250 xcs%functional(
func_x,2)%id = xc_oep_x
251 if (.not. hartree_fock)
then
252 xcs%family = ior(xcs%family, xc_family_oep)
256 if (in_family(xcs%family, [xc_family_lca]))
then
263 if (xcs%functional(
func_x, 1)%id == xc_mgga_x_tb09 .and. periodic_dim /= 3)
then
264 message(1) =
"mgga_x_tb09 functional can only be used for 3D periodic systems"
268 if (family_is_mgga(xcs%family) .or. family_is_nc_mgga(xcs%family))
then
287 push_sub(xc_init.parse)
308 if (abs(xcs%kernel_lrc_alpha) >
m_epsilon)
then
324 call parse_variable(namespace,
'XCDensityCorrection', lr_none, xcs%xc_density_correction)
326 if (xcs%xc_density_correction /= lr_none)
then
344 call parse_variable(namespace,
'XCDensityCorrectionOptimize', .
true., xcs%xcd_optimize_cutoff)
377 call parse_variable(namespace,
'XCDensityCorrectionNormalize', .
true., xcs%xcd_normalize)
402 if(
parse_block(namespace,
'HybridCamParameters', blk) == 0)
then
403 do isp = 1,
size(xcs%cam_ext)
409 if( any(abs(xcs%cam_ext) >
m_epsilon) )
then
411 write(
message(2),
'(a,f8.5)')
"Info: Setting external cam_alpha = ", xcs%cam_ext(1)
412 write(
message(3),
'(a,f8.5)')
"Info: Setting external cam_beta = ", xcs%cam_ext(2)
413 write(
message(4),
'(a,f8.5)')
"Info: Setting external cam_omega = ", xcs%cam_ext(3)
417 pop_sub(xc_init.parse)
420 end subroutine xc_init
424 subroutine xc_end(xcs)
425 type(xc_t),
intent(inout) :: xcs
432 call xc_functional_end(xcs%functional(
func_x, isp))
433 call xc_functional_end(xcs%functional(
func_c, isp))
434 call xc_functional_end(xcs%kernel(
func_x, isp))
435 call xc_functional_end(xcs%kernel(
func_c, isp))
441 end subroutine xc_end
448 logical pure function xc_is_orbital_dependent(xcs)
449 type(xc_t),
intent(in) :: xcs
451 xc_is_orbital_dependent = family_is_hybrid(xcs) .or. &
452 in_family(xcs%functional(
func_x,1)%family, [xc_family_oep]) .or. &
453 in_family(xcs%family, [xc_family_mgga, xc_family_nc_mgga])
455 end function xc_is_orbital_dependent
459 pure logical function family_is_gga(family, only_collinear)
460 integer,
intent(in) :: family
461 logical,
optional,
intent(in) :: only_collinear
463 if(optional_default(only_collinear, .false.))
then
464 family_is_gga = in_family(family, [xc_family_gga, xc_family_hyb_gga, &
465 xc_family_mgga, xc_family_hyb_mgga, xc_family_libvdwxc])
467 family_is_gga = in_family(family, [xc_family_gga, xc_family_hyb_gga, &
468 xc_family_mgga, xc_family_hyb_mgga, xc_family_libvdwxc, xc_family_nc_mgga])
470 end function family_is_gga
477 pure logical function family_is_supported(family)
478 integer,
intent(in) :: family
480 family_is_supported = in_family(family, [xc_family_lda, xc_family_hyb_lda, xc_family_gga, xc_family_hyb_gga, &
481 xc_family_mgga, xc_family_hyb_mgga, xc_family_libvdwxc])
482 end function family_is_supported
486 pure logical function family_is_mgga(family, only_collinear)
487 integer,
optional,
intent(in) :: family
488 logical,
optional,
intent(in) :: only_collinear
490 if(optional_default(only_collinear, .false.))
then
491 family_is_mgga = in_family(family, [xc_family_mgga, xc_family_hyb_mgga])
493 family_is_mgga = in_family(family, [xc_family_mgga, xc_family_hyb_mgga, xc_family_nc_mgga])
495 end function family_is_mgga
499 logical pure function family_is_mgga_with_exc(xcs)
500 type(xc_t),
intent(in) :: xcs
504 family_is_mgga_with_exc = .false.
506 if (in_family(xcs%functional(ixc, 1)%family, [xc_family_mgga, xc_family_hyb_mgga, xc_family_nc_mgga]) &
507 .and. xc_functional_is_energy_functional(xcs%functional(ixc, 1)))
then
508 family_is_mgga_with_exc = .
true.
511 end function family_is_mgga_with_exc
514 logical pure function family_is_hybrid(xcs)
515 type(xc_t),
intent(in) :: xcs
519 family_is_hybrid = .false.
521 if (in_family(xcs%functional(ixc, 1)%family, [xc_family_hyb_lda, xc_family_hyb_gga, xc_family_hyb_mgga]))
then
522 family_is_hybrid = .
true.
525 end function family_is_hybrid
527 pure logical function in_family(family, xc_families)
528 integer,
intent(in) :: family
529 integer,
intent(in) :: xc_families(:)
531 in_family = bitand(family, sum(xc_families)) /= 0
532 end function in_family
536 subroutine copy_global_to_local(global, local, n_block, nspin, ip)
537 real(real64),
intent(in) :: global(:,:)
538 real(real64),
intent(out) :: local(:,:)
539 integer,
intent(in) :: n_block
540 integer,
intent(in) :: nspin
541 integer,
intent(in) :: ip
545 push_sub(copy_global_to_local)
550 local(is, ib) = global(ib + ip - 1, is)
554 pop_sub(copy_global_to_local)
555 end subroutine copy_global_to_local
558 subroutine copy_local_to_global(local, global, n_block, spin_channels, ip)
559 real(real64),
intent(in) :: local(:,:)
560 real(real64),
intent(inout) :: global(:,:)
561 integer,
intent(in) :: n_block
562 integer,
intent(in) :: spin_channels
563 integer,
intent(in) :: ip
567 push_sub(xc_compute_vxc.copy_local_to_global)
569 do is = 1, spin_channels
572 global(ib + ip - 1, is) = global(ib + ip - 1, is) + local(is, ib)
576 pop_sub(xc_compute_vxc.copy_local_to_global)
577 end subroutine copy_local_to_global
581 subroutine set_hybrid_params(xcs,namespace)
582 type(namespace_t),
intent(in) :: namespace
583 type(xc_t),
intent(inout) :: xcs
585 real(real64) :: parameters(3)
587 push_sub(set_hybrid_params)
589 parameters = xcs%cam_ext
590 xcs%cam_alpha = parameters(1)
592 select case(xcs%functional(func_c,1)%id)
593 case(xc_hyb_gga_xc_pbeh, xc_hyb_lda_xc_lda0)
595 if(parameters(1) < m_zero) parameters(1) = 0.25_real64
597 call xc_f03_func_set_ext_params(xcs%functional(func_c,1)%conf, parameters)
598 call xc_f03_func_set_ext_params(xcs%functional(func_c,2)%conf, parameters)
600 write(message(1),
'(a,f6.3,a)')
'Info: Setting mixing parameter (' , parameters(1) ,
').'
601 call messages_info(1)
603 case(xc_hyb_gga_xc_cam_pbeh, xc_hyb_lda_xc_cam_lda0)
604 xcs%cam_beta = parameters(2)
605 xcs%cam_omega = parameters(3)
607 call xc_f03_hyb_cam_coef(xcs%functional(func_c,1)%conf, xcs%cam_omega, &
608 xcs%cam_alpha, xcs%cam_beta)
609 call xc_f03_hyb_cam_coef(xcs%functional(func_c,2)%conf, xcs%cam_omega, &
610 xcs%cam_alpha, xcs%cam_beta)
611 write(message(1),
'(a,f6.3,a)')
'Info: Setting alpha parameter (' , xcs%cam_alpha ,
').'
612 write(message(2),
'(a,f6.3,a)')
'Info: Setting beta parameter (' , xcs%cam_beta ,
').'
613 write(message(3),
'(a,f6.3,a)')
'Info: Setting omega parameter (' , xcs%cam_omega ,
').'
614 call messages_info(3)
620 pop_sub(set_hybrid_params)
621 end subroutine set_hybrid_params
625 logical function xc_is_not_size_consistent(xcs, namespace)
626 type(xc_t),
intent(in) :: xcs
627 type(namespace_t),
intent(in) :: namespace
629 xc_is_not_size_consistent = xc_functional_is_not_size_consistent(xcs%functional(func_x,1), namespace) &
630 .or. xc_functional_is_not_size_consistent(xcs%functional(func_c,1), namespace)
631 end function xc_is_not_size_consistent
635 logical pure function xc_is_energy_functional(xcs)
636 type(xc_t),
intent(in) :: xcs
637 xc_is_energy_functional = xc_functional_is_energy_functional(xcs%functional(func_x,1)) &
638 .or. xc_functional_is_energy_functional(xcs%functional(func_c,1))
639 end function xc_is_energy_functional
641#include "xc_vxc_inc.F90"
642#include "xc_fxc_inc.F90"
643#include "xc_kxc_inc.F90"
645#include "xc_vxc_nc_inc.F90"
This module calculates the derivatives (gradients, Laplacians, etc.) of a function.
integer, parameter, public unpolarized
Parameters...
real(real64), parameter, public m_zero
real(real64), parameter, public m_epsilon
real(real64), parameter, public m_one
This module implements the underlying real-space grid.
This module is intended to contain "only mathematical" functions and procedures.
This module defines various routines, operating on mesh functions.
This module defines the meshes, which are used in Octopus.
subroutine, public messages_not_implemented(feature, namespace)
subroutine, public messages_obsolete_variable(namespace, name, rep)
character(len=256), dimension(max_lines), public message
to be output by fatal, warning
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
subroutine, public messages_experimental(name, namespace)
subroutine, public messages_info(no_lines, iunit, debug_only, stress, all_nodes, namespace)
integer function, public parse_block(namespace, name, blk, check_varinfo_)
This module handles spin dimensions of the states and the k-point distribution.
This module defines the unit system, used for input and output.
integer, parameter, public func_c
integer, parameter, public func_x