20#include "./base/base_uses.f90"
26 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_dispersion_types'
35 INTEGER :: pp_type = -1
36 INTEGER :: nl_type = -1
37 CHARACTER(LEN=default_string_length) :: ref_functional =
""
38 REAL(kind=
dp) :: scaling = -1.0_dp
39 REAL(kind=
dp) :: rc_disp = -1.0_dp
40 REAL(kind=
dp) :: rc_d4 = -1.0_dp
41 REAL(kind=
dp) :: rc_cn = -1.0_dp
42 REAL(kind=
dp) :: exp_pre = -1.0_dp
44 LOGICAL :: verbose = .false.
45 CHARACTER(LEN=default_string_length) :: parameter_file_name =
""
46 CHARACTER(LEN=default_string_length) :: kernel_file_name =
""
48 LOGICAL :: ext_charges = .false.
49 REAL(kind=
dp),
DIMENSION(:),
POINTER :: charges => null()
50 REAL(kind=
dp),
DIMENSION(:),
POINTER :: dcharges => null()
53 INTEGER :: max_elem = -1
55 REAL(kind=
dp) :: k1 = -1.0_dp, k2 = -1.0_dp, k3 = -1.0_dp
56 REAL(kind=
dp) :: alp = -1.0_dp
57 REAL(kind=
dp) :: s6 = -1.0_dp, s8 = -1.0_dp, sr6 = -1.0_dp
58 REAL(kind=
dp) :: a1 = -1.0_dp, a2 = -1.0_dp
59 REAL(kind=
dp) :: eps_cn = -1.0_dp
60 LOGICAL :: d4_reference_code = .false.
61 LOGICAL :: d4_debug = .false.
62 LOGICAL :: doabc = .false.
63 LOGICAL :: c9cnst = .false.
64 LOGICAL :: lrc = .false.
65 LOGICAL :: srb = .false.
66 REAL(kind=
dp),
DIMENSION(4) :: srb_params = -1.0_dp
67 REAL(kind=
dp) :: s9 = -1.0_dp
69 DIMENSION(:),
POINTER :: sab_vdw => null(), sab_cn => null()
70 REAL(kind=
dp),
DIMENSION(:, :, :, :, :),
POINTER &
70 REAL(kind=
dp),
DIMENSION(:, :, :, :, :),
POINTER &
…
72 INTEGER,
DIMENSION(:),
POINTER :: maxci => null()
73 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: r0ab => null()
74 REAL(kind=
dp),
DIMENSION(:),
POINTER :: rcov => null()
75 REAL(kind=
dp),
DIMENSION(:),
POINTER :: eneg => null()
76 REAL(kind=
dp),
DIMENSION(:),
POINTER :: r2r4 => null()
78 REAL(kind=
dp),
DIMENSION(:),
POINTER :: cn => null()
79 TYPE(cn_kind_list),
DIMENSION(:),
POINTER :: cnkind => null()
80 TYPE(cn_atom_list),
DIMENSION(:),
POINTER :: cnlist => null()
82 LOGICAL :: domol = .false.
83 REAL(kind=
dp) :: kgc8 = -1.0_dp
85 REAL(kind=
dp) :: pw_cutoff = -1.0_dp
87 REAL(kind=
dp) :: b_value = -1.0_dp, c_value = -1.0_dp, scale_rvv10 = -1.0_dp
88 INTEGER :: nqs = -1, nr_points = -1
92 REAL(kind=
dp) :: r_max = -1.0_dp, q_cut = -1.0_dp, q_min = -1.0_dp, dk = -1.0_dp
98 REAL(kind=
dp),
DIMENSION(:),
POINTER :: q_mesh => null()
99 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER &
99 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER &
…
103 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER &
104 :: d2phi_dk2 => null()
103 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER &
…
107 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: d2y_dx2 => null()
108 INTEGER,
DIMENSION(:, :),
POINTER :: d3_exclude_pair => null()
109 INTEGER :: nd3_exclude_pair = -1
114 LOGICAL :: defined = .false.
115 REAL(kind=
dp) :: vdw_radii = -1.0_dp
116 REAL(kind=
dp) :: c6 = -1.0_dp
120 REAL(kind=
dp) :: cnum = -1.0_dp
122 END TYPE cn_kind_list
124 REAL(kind=
dp) :: cnum = -1.0_dp
125 INTEGER :: natom = -1
126 INTEGER,
DIMENSION(:),
POINTER ::
atom => null()
127 END TYPE cn_atom_list
147 IF (
ASSOCIATED(dispersion_env))
THEN
149 IF (
ASSOCIATED(dispersion_env%maxci))
THEN
150 DEALLOCATE (dispersion_env%maxci)
152 IF (
ASSOCIATED(dispersion_env%c6ab))
THEN
153 DEALLOCATE (dispersion_env%c6ab)
155 IF (
ASSOCIATED(dispersion_env%r0ab))
THEN
156 DEALLOCATE (dispersion_env%r0ab)
158 IF (
ASSOCIATED(dispersion_env%rcov))
THEN
159 DEALLOCATE (dispersion_env%rcov)
161 IF (
ASSOCIATED(dispersion_env%eneg))
THEN
162 DEALLOCATE (dispersion_env%eneg)
164 IF (
ASSOCIATED(dispersion_env%r2r4))
THEN
165 DEALLOCATE (dispersion_env%r2r4)
167 IF (
ASSOCIATED(dispersion_env%cn))
THEN
168 DEALLOCATE (dispersion_env%cn)
170 IF (
ASSOCIATED(dispersion_env%cnkind))
THEN
171 DEALLOCATE (dispersion_env%cnkind)
173 IF (
ASSOCIATED(dispersion_env%cnlist))
THEN
174 DO i = 1,
SIZE(dispersion_env%cnlist)
175 DEALLOCATE (dispersion_env%cnlist(i)%atom)
177 DEALLOCATE (dispersion_env%cnlist)
180 IF (
ASSOCIATED(dispersion_env%q_mesh))
THEN
181 DEALLOCATE (dispersion_env%q_mesh)
183 IF (
ASSOCIATED(dispersion_env%kernel))
THEN
184 DEALLOCATE (dispersion_env%kernel)
186 IF (
ASSOCIATED(dispersion_env%d2phi_dk2))
THEN
187 DEALLOCATE (dispersion_env%d2phi_dk2)
189 IF (
ASSOCIATED(dispersion_env%d2y_dx2))
THEN
190 DEALLOCATE (dispersion_env%d2y_dx2)
192 IF (
ASSOCIATED(dispersion_env%d3_exclude_pair))
THEN
193 DEALLOCATE (dispersion_env%d3_exclude_pair)
199 IF (
ASSOCIATED(dispersion_env%charges))
THEN
200 DEALLOCATE (dispersion_env%charges)
202 IF (
ASSOCIATED(dispersion_env%dcharges))
THEN
203 DEALLOCATE (dispersion_env%dcharges)
206 DEALLOCATE (dispersion_env)
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_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