21#include "./base/base_uses.f90"
27 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_dispersion_types'
36 INTEGER :: pp_type = -1
37 INTEGER :: nl_type = -1
38 CHARACTER(LEN=default_string_length) :: ref_functional =
""
39 REAL(kind=
dp) :: scaling = -1.0_dp
40 REAL(kind=
dp) :: rc_disp = -1.0_dp
41 REAL(kind=
dp) :: rc_d4 = -1.0_dp
42 REAL(kind=
dp) :: rc_cn = -1.0_dp
43 REAL(kind=
dp) :: exp_pre = -1.0_dp
45 LOGICAL :: verbose = .false.
46 CHARACTER(LEN=default_path_length) :: parameter_file_name =
""
47 CHARACTER(LEN=default_path_length) :: kernel_file_name =
""
49 LOGICAL :: ext_charges = .false.
50 REAL(kind=
dp),
DIMENSION(:),
POINTER :: charges => null()
51 REAL(kind=
dp),
DIMENSION(:),
POINTER :: dcharges => null()
54 INTEGER :: max_elem = -1
56 REAL(kind=
dp) :: k1 = -1.0_dp, k2 = -1.0_dp, k3 = -1.0_dp
57 REAL(kind=
dp) :: alp = -1.0_dp
58 REAL(kind=
dp) :: s6 = -1.0_dp, s8 = -1.0_dp, sr6 = -1.0_dp
59 REAL(kind=
dp) :: a1 = -1.0_dp, a2 = -1.0_dp
60 REAL(kind=
dp) :: eps_cn = -1.0_dp
61 LOGICAL :: d4_reference_code = .false.
62 LOGICAL :: d4_debug = .false.
63 LOGICAL :: doabc = .false.
64 LOGICAL :: c9cnst = .false.
65 LOGICAL :: lrc = .false.
66 LOGICAL :: srb = .false.
67 REAL(kind=
dp),
DIMENSION(4) :: srb_params = -1.0_dp
68 REAL(kind=
dp) :: s9 = -1.0_dp
70 DIMENSION(:),
POINTER :: sab_vdw => null(), sab_cn => null()
71 REAL(kind=
dp),
DIMENSION(:, :, :, :, :),
POINTER &
73 INTEGER,
DIMENSION(:),
POINTER :: maxci => null()
74 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: r0ab => null()
75 REAL(kind=
dp),
DIMENSION(:),
POINTER :: rcov => null()
76 REAL(kind=
dp),
DIMENSION(:),
POINTER :: eneg => null()
77 REAL(kind=
dp),
DIMENSION(:),
POINTER :: r2r4 => null()
79 REAL(kind=
dp),
DIMENSION(:),
POINTER :: cn => null()
80 TYPE(cn_kind_list),
DIMENSION(:),
POINTER :: cnkind => null()
81 TYPE(cn_atom_list),
DIMENSION(:),
POINTER :: cnlist => null()
83 LOGICAL :: domol = .false.
84 REAL(kind=
dp) :: kgc8 = -1.0_dp
86 REAL(kind=
dp) :: pw_cutoff = -1.0_dp
88 REAL(kind=
dp) :: b_value = -1.0_dp, c_value = -1.0_dp, scale_rvv10 = -1.0_dp
89 INTEGER :: nqs = -1, nr_points = -1
93 REAL(kind=
dp) :: r_max = -1.0_dp, q_cut = -1.0_dp, q_min = -1.0_dp, dk = -1.0_dp
99 REAL(kind=
dp),
DIMENSION(:),
POINTER :: q_mesh => null()
100 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER &
104 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER &
105 :: d2phi_dk2 => null()
108 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: d2y_dx2 => null()
109 INTEGER,
DIMENSION(:, :),
POINTER :: d3_exclude_pair => null()
110 INTEGER :: nd3_exclude_pair = -1
115 LOGICAL :: defined = .false.
116 REAL(kind=
dp) :: vdw_radii = -1.0_dp
117 REAL(kind=
dp) :: c6 = -1.0_dp
121 REAL(kind=
dp) :: cnum = -1.0_dp
123 END TYPE cn_kind_list
125 REAL(kind=
dp) :: cnum = -1.0_dp
126 INTEGER :: natom = -1
127 INTEGER,
DIMENSION(:),
POINTER ::
atom => null()
128 END TYPE cn_atom_list
148 IF (
ASSOCIATED(dispersion_env))
THEN
150 IF (
ASSOCIATED(dispersion_env%maxci))
THEN
151 DEALLOCATE (dispersion_env%maxci)
153 IF (
ASSOCIATED(dispersion_env%c6ab))
THEN
154 DEALLOCATE (dispersion_env%c6ab)
156 IF (
ASSOCIATED(dispersion_env%r0ab))
THEN
157 DEALLOCATE (dispersion_env%r0ab)
159 IF (
ASSOCIATED(dispersion_env%rcov))
THEN
160 DEALLOCATE (dispersion_env%rcov)
162 IF (
ASSOCIATED(dispersion_env%eneg))
THEN
163 DEALLOCATE (dispersion_env%eneg)
165 IF (
ASSOCIATED(dispersion_env%r2r4))
THEN
166 DEALLOCATE (dispersion_env%r2r4)
168 IF (
ASSOCIATED(dispersion_env%cn))
THEN
169 DEALLOCATE (dispersion_env%cn)
171 IF (
ASSOCIATED(dispersion_env%cnkind))
THEN
172 DEALLOCATE (dispersion_env%cnkind)
174 IF (
ASSOCIATED(dispersion_env%cnlist))
THEN
175 DO i = 1,
SIZE(dispersion_env%cnlist)
176 DEALLOCATE (dispersion_env%cnlist(i)%atom)
178 DEALLOCATE (dispersion_env%cnlist)
181 IF (
ASSOCIATED(dispersion_env%q_mesh))
THEN
182 DEALLOCATE (dispersion_env%q_mesh)
184 IF (
ASSOCIATED(dispersion_env%kernel))
THEN
185 DEALLOCATE (dispersion_env%kernel)
187 IF (
ASSOCIATED(dispersion_env%d2phi_dk2))
THEN
188 DEALLOCATE (dispersion_env%d2phi_dk2)
190 IF (
ASSOCIATED(dispersion_env%d2y_dx2))
THEN
191 DEALLOCATE (dispersion_env%d2y_dx2)
193 IF (
ASSOCIATED(dispersion_env%d3_exclude_pair))
THEN
194 DEALLOCATE (dispersion_env%d3_exclude_pair)
200 IF (
ASSOCIATED(dispersion_env%charges))
THEN
201 DEALLOCATE (dispersion_env%charges)
203 IF (
ASSOCIATED(dispersion_env%dcharges))
THEN
204 DEALLOCATE (dispersion_env%dcharges)
207 DEALLOCATE (dispersion_env)
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
integer, parameter, public default_path_length
Definition of disperson types for DFT calculations.
integer, parameter, public dftd2_pp
integer, parameter, public dftd4_pp
subroutine, public qs_dispersion_release(dispersion_env)
...
integer, parameter, public dftd3_pp
Define the neighbor list data types and the corresponding functionality.
subroutine, public release_neighbor_list_sets(nlists)
releases an array of neighbor_list_sets