Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : MODULE qs_dispersion_s_dftd3
9 :
10 : USE input_constants, ONLY: vdw_pairpot_dftd3, &
11 : vdw_pairpot_dftd3bj
12 : USE kinds, ONLY: default_string_length, &
13 : dp
14 : USE message_passing, ONLY: mp_para_env_type
15 : USE qs_dispersion_cnum, ONLY: setr0ab
16 :
17 : #if defined(__S_DFTD3)
18 : USE dftd3_data_r4r2, ONLY: get_r4r2_val
19 : USE dftd3_data_vdwrad, ONLY: get_vdw_rad
20 : USE dftd3_param, ONLY: d3_param, &
21 : get_rational_damping, &
22 : get_zero_damping
23 : USE dftd3_reference, ONLY: init_reference_c6, &
24 : get_c6, &
25 : reference_cn, &
26 : number_of_references
27 : USE mctc_data, ONLY: get_covalent_rad
28 : USE mctc_env, ONLY: error_type
29 : #endif
30 :
31 : #include "./base/base_uses.f90"
32 :
33 : IMPLICIT NONE
34 :
35 : PRIVATE
36 :
37 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_dispersion_s_dftd3'
38 :
39 : PUBLIC :: dftd3_param_from_library, dftd3_functional_supported
40 :
41 : CONTAINS
42 :
43 : ! **************************************************************************************************
44 : !> \brief Check if a functional is supported by the s-dftd3 library
45 : !> \param pp_type ...
46 : !> \param ref_functional ...
47 : !> \param found ...
48 : ! **************************************************************************************************
49 0 : SUBROUTINE dftd3_functional_supported(pp_type, ref_functional, found)
50 : INTEGER, INTENT(IN) :: pp_type
51 : CHARACTER(LEN=*), INTENT(IN) :: ref_functional
52 : LOGICAL, INTENT(OUT) :: found
53 :
54 : #if defined(__S_DFTD3)
55 :
56 : CHARACTER(LEN=default_string_length) :: func_name
57 : TYPE(d3_param) :: d3params
58 : TYPE(error_type), ALLOCATABLE :: lib_error
59 :
60 0 : ALLOCATE (lib_error)
61 0 : func_name = ref_functional
62 : d3params = d3_param()
63 0 : found = .TRUE.
64 :
65 0 : SELECT CASE (pp_type)
66 : CASE (vdw_pairpot_dftd3)
67 0 : CALL get_zero_damping(d3params, func_name, lib_error)
68 : CASE (vdw_pairpot_dftd3bj)
69 0 : CALL get_rational_damping(d3params, func_name, lib_error)
70 : CASE DEFAULT
71 0 : d3params = d3_param()
72 : END SELECT
73 :
74 0 : found = .NOT. ALLOCATED(lib_error)
75 :
76 : #else
77 : MARK_USED(pp_type)
78 : MARK_USED(ref_functional)
79 : found = .FALSE.
80 : #endif
81 :
82 0 : END SUBROUTINE dftd3_functional_supported
83 :
84 : ! **************************************************************************************************
85 : !> \brief ...
86 : !> \param c6ab ...
87 : !> \param maxci ...
88 : !> \param r0ab ...
89 : !> \param rcov ...
90 : !> \param r2r4 ...
91 : !> \param pp_type ...
92 : !> \param ref_functional ...
93 : !> \param s6 ...
94 : !> \param s8 ...
95 : !> \param a1 ...
96 : !> \param a2 ...
97 : !> \param sr6 ...
98 : !> \param sr8 ...
99 : !> \param para_env ...
100 : !> \param error ...
101 : !> \param calc_scaling ...
102 : ! **************************************************************************************************
103 52 : SUBROUTINE dftd3_param_from_library(c6ab, maxci, r0ab, rcov, r2r4, &
104 : pp_type, ref_functional, &
105 : s6, s8, a1, a2, sr6, sr8, &
106 : para_env, error, calc_scaling)
107 :
108 : REAL(KIND=dp), DIMENSION(:, :, :, :, :), &
109 : INTENT(INOUT) :: c6ab
110 : INTEGER, DIMENSION(:), INTENT(INOUT) :: maxci
111 : REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: r0ab
112 : REAL(KIND=dp), DIMENSION(:), INTENT(INOUT) :: rcov, r2r4
113 : INTEGER, INTENT(IN) :: pp_type
114 : CHARACTER(LEN=*), INTENT(IN) :: ref_functional
115 : REAL(KIND=dp), INTENT(INOUT) :: s6, s8, a1, a2, sr6, sr8
116 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env
117 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: error
118 : LOGICAL, INTENT(IN), OPTIONAL :: calc_scaling
119 :
120 : #if defined(__S_DFTD3)
121 :
122 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dftd3_param_from_library'
123 :
124 : CHARACTER(LEN=default_string_length) :: func_name
125 : INTEGER :: handle, i, iz, jref, jz, nelem, nref
126 : LOGICAL :: do_calc_scaling
127 : REAL(KIND=dp) :: c6_val, r4r2, rcov_val
128 : REAL(KIND=dp), DIMENSION(94) :: r2r4_tmp, rcov_tmp
129 : TYPE(d3_param) :: d3params
130 52 : TYPE(error_type), ALLOCATABLE :: lib_error
131 :
132 52 : CALL timeset(routineN, handle)
133 :
134 52 : CALL init_reference_c6()
135 :
136 52 : nref = 7
137 52 : nelem = MIN(94, SIZE(maxci))
138 :
139 5408 : maxci(:) = 0
140 4940 : DO iz = 1, nelem
141 4940 : maxci(iz) = number_of_references(iz)
142 : END DO
143 :
144 52 : IF (para_env%is_source()) THEN
145 2470 : DO iz = 1, nelem
146 2444 : rcov_val = get_covalent_rad(iz)
147 2444 : rcov_tmp(iz) = rcov_val
148 :
149 2444 : r4r2 = get_r4r2_val(iz)
150 2470 : r2r4_tmp(iz) = r4r2
151 : END DO
152 :
153 278538 : r0ab = 0.0_dp
154 2470 : DO iz = 1, nelem
155 232206 : DO jz = 1, nelem
156 232180 : IF (r2r4_tmp(iz) > 0.0_dp .AND. r2r4_tmp(jz) > 0.0_dp) THEN
157 229736 : r0ab(iz, jz) = get_vdw_rad(iz, jz)
158 : END IF
159 : END DO
160 : END DO
161 :
162 40945736 : c6ab = 0.0_dp
163 208 : DO jref = 1, nref
164 17316 : DO jz = 1, nelem
165 137046 : DO i = 1, nref
166 11393928 : DO iz = 1, nelem
167 11257064 : c6_val = get_c6(i, jref, iz, jz)
168 11257064 : c6ab(iz, jz, i, jref, 1) = c6_val
169 11257064 : c6ab(iz, jz, i, jref, 2) = reference_cn(i, iz)
170 11376820 : c6ab(iz, jz, i, jref, 3) = reference_cn(jref, jz)
171 : END DO
172 : END DO
173 : END DO
174 : END DO
175 : END IF
176 :
177 52 : CALL para_env%bcast(r2r4_tmp)
178 1114100 : CALL para_env%bcast(r0ab)
179 52 : CALL para_env%bcast(rcov_tmp)
180 :
181 52 : IF (.NOT. para_env%is_source()) THEN
182 40945736 : c6ab = 0.0_dp
183 208 : DO jref = 1, nref
184 17316 : DO jz = 1, nelem
185 137046 : DO i = 1, nref
186 11393928 : DO iz = 1, nelem
187 11257064 : c6_val = get_c6(i, jref, iz, jz)
188 11257064 : c6ab(iz, jz, i, jref, 1) = c6_val
189 11257064 : c6ab(iz, jz, i, jref, 2) = reference_cn(i, iz)
190 11376820 : c6ab(iz, jz, i, jref, 3) = reference_cn(jref, jz)
191 : END DO
192 : END DO
193 : END DO
194 : END DO
195 : END IF
196 :
197 4940 : r2r4(:nelem) = r2r4_tmp(:nelem)
198 4940 : rcov(:nelem) = rcov_tmp(:nelem)
199 :
200 52 : func_name = ref_functional
201 52 : d3params = d3_param()
202 :
203 52 : IF (para_env%is_source()) THEN
204 36 : SELECT CASE (pp_type)
205 : CASE (vdw_pairpot_dftd3)
206 10 : CALL get_zero_damping(d3params, func_name, lib_error)
207 : CASE (vdw_pairpot_dftd3bj)
208 16 : CALL get_rational_damping(d3params, func_name, lib_error)
209 : CASE DEFAULT
210 26 : d3params = d3_param()
211 : END SELECT
212 26 : IF (ALLOCATED(lib_error)) THEN
213 0 : IF (PRESENT(error)) THEN
214 0 : error = "Functional '"//TRIM(ref_functional)//"' not found in s-dftd3 library"
215 : END IF
216 0 : RETURN
217 : END IF
218 : END IF
219 :
220 52 : CALL para_env%bcast(func_name)
221 52 : CALL para_env%bcast(d3params%s6)
222 52 : CALL para_env%bcast(d3params%s8)
223 52 : CALL para_env%bcast(d3params%a1)
224 52 : CALL para_env%bcast(d3params%a2)
225 52 : CALL para_env%bcast(d3params%rs6)
226 52 : CALL para_env%bcast(d3params%rs8)
227 :
228 52 : IF (PRESENT(error)) error = ""
229 :
230 52 : do_calc_scaling = .TRUE.
231 52 : IF (PRESENT(calc_scaling)) do_calc_scaling = calc_scaling
232 :
233 52 : sr8 = d3params%rs8
234 52 : IF (do_calc_scaling) THEN
235 50 : s6 = d3params%s6
236 50 : s8 = d3params%s8
237 50 : a1 = d3params%a1
238 50 : a2 = d3params%a2
239 50 : sr6 = d3params%rs6
240 : END IF
241 :
242 52 : CALL timestop(handle)
243 :
244 : #else
245 : MARK_USED(c6ab)
246 : MARK_USED(maxci)
247 : MARK_USED(r0ab)
248 : MARK_USED(rcov)
249 : MARK_USED(r2r4)
250 : MARK_USED(pp_type)
251 : MARK_USED(ref_functional)
252 : MARK_USED(s6)
253 : MARK_USED(s8)
254 : MARK_USED(a1)
255 : MARK_USED(a2)
256 : MARK_USED(sr6)
257 : MARK_USED(sr8)
258 : MARK_USED(para_env)
259 : MARK_USED(error)
260 : MARK_USED(calc_scaling)
261 : CPABORT("s-dftd3 library not compiled in")
262 : #endif
263 :
264 156 : END SUBROUTINE dftd3_param_from_library
265 :
266 : END MODULE qs_dispersion_s_dftd3
|
