Loading [MathJax]/extensions/tex2jax.js
 (git:b77b4be)
All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
qs_dispersion_types.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Definition of disperson types for DFT calculations
10!> \author JGH (20.10.2008)
11! **************************************************************************************************
13
14 USE eeq_input, ONLY: eeq_solver_type
16 USE kinds, ONLY: default_string_length,&
17 dp
20#include "./base/base_uses.f90"
21
22 IMPLICIT NONE
23
24 PRIVATE
25
26 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_dispersion_types'
27
28! **************************************************************************************************
29 INTEGER, PARAMETER :: dftd2_pp = 1
30 INTEGER, PARAMETER :: dftd3_pp = 2
31 INTEGER, PARAMETER :: dftd4_pp = 3
32
34 INTEGER :: TYPE = -1
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
43 TYPE(section_vals_type), POINTER :: dftd_section => null()
44 LOGICAL :: verbose = .false. !extended output
45 CHARACTER(LEN=default_string_length) :: parameter_file_name = ""
46 CHARACTER(LEN=default_string_length) :: kernel_file_name = ""
47 !charges
48 LOGICAL :: ext_charges = .false.
49 REAL(kind=dp), DIMENSION(:), POINTER :: charges => null() !charges for D4
50 REAL(kind=dp), DIMENSION(:), POINTER :: dcharges => null() !derivatives of D4 energy wrt charges
51 TYPE(eeq_solver_type) :: eeq_sparam ! parameters for EEQ solver
52 !DFT-D3 global parameters
53 INTEGER :: max_elem = -1 !elements parametrized
54 INTEGER :: maxc = -1 !max coordination number references per element
55 REAL(kind=dp) :: k1 = -1.0_dp, k2 = -1.0_dp, k3 = -1.0_dp !ad hoc parameters
56 REAL(kind=dp) :: alp = -1.0_dp !ad hoc parameters
57 REAL(kind=dp) :: s6 = -1.0_dp, s8 = -1.0_dp, sr6 = -1.0_dp !scaling parameters
58 REAL(kind=dp) :: a1 = -1.0_dp, a2 = -1.0_dp !BJ scaling parameters
59 REAL(kind=dp) :: eps_cn = -1.0_dp
60 LOGICAL :: d4_reference_code = .false. !Use D4 calculation from ext. library
61 LOGICAL :: d4_debug = .false. !Output debug information for D4
62 LOGICAL :: doabc = .false. !neglect C9 terms
63 LOGICAL :: c9cnst = .false. !use constant c9 terms
64 LOGICAL :: lrc = .false. !calculate a long range correction
65 LOGICAL :: srb = .false. !calculate a short range bond correction
66 REAL(kind=dp), DIMENSION(4) :: srb_params = -1.0_dp ! parameters for SRB (s,g,t1,t2)
67 REAL(kind=dp) :: s9 = -1.0_dp !scale the many-body dispersion energy (default=1.0), dftd4
69 DIMENSION(:), POINTER :: sab_vdw => null(), sab_cn => null() ! neighborlists for pair interactions
70 REAL(kind=dp), DIMENSION(:, :, :, :, :), POINTER &
71 :: c6ab => null()
72 INTEGER, DIMENSION(:), POINTER :: maxci => null()
73 REAL(kind=dp), DIMENSION(:, :), POINTER :: r0ab => null()
74 REAL(kind=dp), DIMENSION(:), POINTER :: rcov => null() !covalent radii
75 REAL(kind=dp), DIMENSION(:), POINTER :: eneg => null() !electronegativity
76 REAL(kind=dp), DIMENSION(:), POINTER :: r2r4 => null() !atomic <r^2>/<r^4> values
77 INTEGER :: cnfun = 1 ! CN function to be used
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()
81 ! KG molecular corrections
82 LOGICAL :: domol = .false.
83 REAL(kind=dp) :: kgc8 = -1.0_dp !s8 scaling parameter
84 !vdW-DF variables
85 REAL(kind=dp) :: pw_cutoff = -1.0_dp
86 !parameters for the rVV10 functional
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
89 !! The number of q points and radial points
90 !! used in generating the kernel phi(q1*r, q2*r)
91 !! (see DION 14-16 and SOLER 3)
92 REAL(kind=dp) :: r_max = -1.0_dp, q_cut = -1.0_dp, q_min = -1.0_dp, dk = -1.0_dp
93 !! The maximum value of r, the maximum and minimum
94 !! values of q and the k-space spacing of grid points.
95 !! Note that, during a vdW run, values of q0 found
96 !! larger than q_cut will be saturated (SOLER 6-7) to
97 !! q_cut
98 REAL(kind=dp), DIMENSION(:), POINTER :: q_mesh => null() !! The values of all the q points used
99 REAL(kind=dp), DIMENSION(:, :, :), POINTER &
100 :: kernel => null() !! A matrix holding the Fourier transformed kernel function
101 !! for each pair of q values. The ordering is
102 !! kernel(k_point, q1_value, q2_value)
103 REAL(kind=dp), DIMENSION(:, :, :), POINTER &
104 :: d2phi_dk2 => null() !! A matrix holding the second derivatives of the above
105 !! kernel matrix at each of the q points. Stored as
106 !! d2phi_dk2(k_point, q1_value, q2_value)
107 REAL(kind=dp), DIMENSION(:, :), POINTER :: d2y_dx2 => null() !! 2nd derivatives of q_mesh for interpolation
108 INTEGER, DIMENSION(:, :), POINTER :: d3_exclude_pair => null()
109 INTEGER :: nd3_exclude_pair = -1
110 END TYPE qs_dispersion_type
111
113 INTEGER :: TYPE = -1
114 LOGICAL :: defined = .false.
115 REAL(kind=dp) :: vdw_radii = -1.0_dp !van der Waals radii
116 REAL(kind=dp) :: c6 = -1.0_dp !c6 coefficients
118
119 TYPE cn_kind_list
120 REAL(kind=dp) :: cnum = -1.0_dp
121 INTEGER :: kind = -1
122 END TYPE cn_kind_list
123 TYPE cn_atom_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
128
129! **************************************************************************************************
130
132 PUBLIC :: dftd2_pp, dftd3_pp, dftd4_pp
133 PUBLIC :: qs_dispersion_release
134
135! **************************************************************************************************
136CONTAINS
137! **************************************************************************************************
138!> \brief ...
139!> \param dispersion_env ...
140! **************************************************************************************************
141 SUBROUTINE qs_dispersion_release(dispersion_env)
142
143 TYPE(qs_dispersion_type), POINTER :: dispersion_env
144
145 INTEGER :: i
146
147 IF (ASSOCIATED(dispersion_env)) THEN
148 ! DFT-D3 arrays
149 IF (ASSOCIATED(dispersion_env%maxci)) THEN
150 DEALLOCATE (dispersion_env%maxci)
151 END IF
152 IF (ASSOCIATED(dispersion_env%c6ab)) THEN
153 DEALLOCATE (dispersion_env%c6ab)
154 END IF
155 IF (ASSOCIATED(dispersion_env%r0ab)) THEN
156 DEALLOCATE (dispersion_env%r0ab)
157 END IF
158 IF (ASSOCIATED(dispersion_env%rcov)) THEN
159 DEALLOCATE (dispersion_env%rcov)
160 END IF
161 IF (ASSOCIATED(dispersion_env%eneg)) THEN
162 DEALLOCATE (dispersion_env%eneg)
163 END IF
164 IF (ASSOCIATED(dispersion_env%r2r4)) THEN
165 DEALLOCATE (dispersion_env%r2r4)
166 END IF
167 IF (ASSOCIATED(dispersion_env%cn)) THEN
168 DEALLOCATE (dispersion_env%cn)
169 END IF
170 IF (ASSOCIATED(dispersion_env%cnkind)) THEN
171 DEALLOCATE (dispersion_env%cnkind)
172 END IF
173 IF (ASSOCIATED(dispersion_env%cnlist)) THEN
174 DO i = 1, SIZE(dispersion_env%cnlist)
175 DEALLOCATE (dispersion_env%cnlist(i)%atom)
176 END DO
177 DEALLOCATE (dispersion_env%cnlist)
178 END IF
179 ! vdD-DF
180 IF (ASSOCIATED(dispersion_env%q_mesh)) THEN
181 DEALLOCATE (dispersion_env%q_mesh)
182 END IF
183 IF (ASSOCIATED(dispersion_env%kernel)) THEN
184 DEALLOCATE (dispersion_env%kernel)
185 END IF
186 IF (ASSOCIATED(dispersion_env%d2phi_dk2)) THEN
187 DEALLOCATE (dispersion_env%d2phi_dk2)
188 END IF
189 IF (ASSOCIATED(dispersion_env%d2y_dx2)) THEN
190 DEALLOCATE (dispersion_env%d2y_dx2)
191 END IF
192 IF (ASSOCIATED(dispersion_env%d3_exclude_pair)) THEN
193 DEALLOCATE (dispersion_env%d3_exclude_pair)
194 END IF
195 ! neighborlists
196 CALL release_neighbor_list_sets(dispersion_env%sab_vdw)
197 CALL release_neighbor_list_sets(dispersion_env%sab_cn)
198 ! charges
199 IF (ASSOCIATED(dispersion_env%charges)) THEN
200 DEALLOCATE (dispersion_env%charges)
201 END IF
202 IF (ASSOCIATED(dispersion_env%dcharges)) THEN
203 DEALLOCATE (dispersion_env%dcharges)
204 END IF
205
206 DEALLOCATE (dispersion_env)
207
208 END IF
209
210 END SUBROUTINE qs_dispersion_release
211
212END MODULE qs_dispersion_types
213
Definition atom.F:9
Input definition and setup for EEQ model.
Definition eeq_input.F:12
objects that represent the structure of input sections and the data contained in an input section
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
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