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