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_local_rho_types
9 :
10 : USE kinds, ONLY: dp
11 : USE mathconstants, ONLY: fourpi,&
12 : pi
13 : USE memory_utilities, ONLY: reallocate
14 : USE qs_cneo_types, ONLY: deallocate_rhoz_cneo_set,&
15 : rhoz_cneo_type
16 : USE qs_grid_atom, ONLY: grid_atom_type
17 : USE qs_harmonics_atom, ONLY: harmonics_atom_type
18 : USE qs_rho0_types, ONLY: deallocate_rho0_atom,&
19 : deallocate_rho0_mpole,&
20 : rho0_atom_type,&
21 : rho0_mpole_type
22 : USE qs_rho_atom_types, ONLY: deallocate_rho_atom_set,&
23 : rho_atom_type
24 : #include "./base/base_uses.f90"
25 :
26 : IMPLICIT NONE
27 :
28 : PRIVATE
29 :
30 : ! *** Global parameters (only in this module)
31 :
32 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_local_rho_types'
33 :
34 : ! *** Define rhoz and local_rho types ***
35 :
36 : ! **************************************************************************************************
37 : TYPE rhoz_type
38 : REAL(dp) :: one_atom = -1.0_dp
39 : REAL(dp), DIMENSION(:), POINTER :: r_coef => NULL()
40 : REAL(dp), DIMENSION(:), POINTER :: dr_coef => NULL()
41 : REAL(dp), DIMENSION(:), POINTER :: vr_coef => NULL()
42 : END TYPE rhoz_type
43 :
44 : ! **************************************************************************************************
45 : TYPE local_rho_type
46 : TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set => NULL()
47 : TYPE(rho0_mpole_type), POINTER :: rho0_mpole => NULL()
48 : TYPE(rho0_atom_type), DIMENSION(:), POINTER :: rho0_atom_set => NULL()
49 : TYPE(rhoz_type), DIMENSION(:), POINTER :: rhoz_set => NULL()
50 : TYPE(rhoz_cneo_type), DIMENSION(:), POINTER :: rhoz_cneo_set => NULL()
51 : REAL(dp) :: rhoz_tot = -1.0_dp, &
52 : rhoz_cneo_tot = -1.0_dp
53 : END TYPE local_rho_type
54 :
55 : ! Public Types
56 : PUBLIC :: local_rho_type, rhoz_type
57 :
58 : ! Public Subroutine
59 : PUBLIC :: allocate_rhoz, calculate_rhoz, &
60 : get_local_rho, local_rho_set_create, &
61 : local_rho_set_release, set_local_rho
62 :
63 : CONTAINS
64 :
65 : ! **************************************************************************************************
66 : !> \brief ...
67 : !> \param rhoz_set ...
68 : !> \param nkind ...
69 : ! **************************************************************************************************
70 3626 : SUBROUTINE allocate_rhoz(rhoz_set, nkind)
71 :
72 : TYPE(rhoz_type), DIMENSION(:), POINTER :: rhoz_set
73 : INTEGER :: nkind
74 :
75 : INTEGER :: ikind
76 :
77 3626 : IF (ASSOCIATED(rhoz_set)) THEN
78 0 : CALL deallocate_rhoz(rhoz_set)
79 : END IF
80 :
81 18128 : ALLOCATE (rhoz_set(nkind))
82 :
83 10876 : DO ikind = 1, nkind
84 7250 : NULLIFY (rhoz_set(ikind)%r_coef)
85 7250 : NULLIFY (rhoz_set(ikind)%dr_coef)
86 10876 : NULLIFY (rhoz_set(ikind)%vr_coef)
87 : END DO
88 :
89 3626 : END SUBROUTINE allocate_rhoz
90 :
91 : ! **************************************************************************************************
92 : !> \brief ...
93 : !> \param rhoz ...
94 : !> \param grid_atom ...
95 : !> \param alpha ...
96 : !> \param zeff ...
97 : !> \param natom ...
98 : !> \param rhoz_tot ...
99 : !> \param harmonics ...
100 : ! **************************************************************************************************
101 7242 : SUBROUTINE calculate_rhoz(rhoz, grid_atom, alpha, zeff, natom, rhoz_tot, harmonics)
102 :
103 : TYPE(rhoz_type) :: rhoz
104 : TYPE(grid_atom_type) :: grid_atom
105 : REAL(dp), INTENT(IN) :: alpha
106 : REAL(dp) :: zeff
107 : INTEGER :: natom
108 : REAL(dp), INTENT(INOUT) :: rhoz_tot
109 : TYPE(harmonics_atom_type) :: harmonics
110 :
111 : INTEGER :: ir, na, nr
112 : REAL(dp) :: c1, c2, c3, prefactor1, prefactor2, &
113 : prefactor3, sum
114 :
115 7242 : nr = grid_atom%nr
116 7242 : na = grid_atom%ng_sphere
117 7242 : CALL reallocate(rhoz%r_coef, 1, nr)
118 7242 : CALL reallocate(rhoz%dr_coef, 1, nr)
119 7242 : CALL reallocate(rhoz%vr_coef, 1, nr)
120 :
121 7242 : c1 = alpha/pi
122 7242 : c2 = c1*c1*c1*fourpi
123 7242 : c3 = SQRT(alpha)
124 7242 : prefactor1 = zeff*SQRT(c2)
125 7242 : prefactor2 = -2.0_dp*alpha
126 7242 : prefactor3 = -zeff*SQRT(fourpi)
127 :
128 7242 : sum = 0.0_dp
129 373406 : DO ir = 1, nr
130 366164 : c1 = -alpha*grid_atom%rad2(ir)
131 366164 : rhoz%r_coef(ir) = -EXP(c1)*prefactor1
132 366164 : IF (ABS(rhoz%r_coef(ir)) < 1.0E-30_dp) THEN
133 241532 : rhoz%r_coef(ir) = 0.0_dp
134 241532 : rhoz%dr_coef(ir) = 0.0_dp
135 : ELSE
136 124632 : rhoz%dr_coef(ir) = prefactor2*rhoz%r_coef(ir)
137 : END IF
138 366164 : rhoz%vr_coef(ir) = prefactor3*erf(grid_atom%rad(ir)*c3)/grid_atom%rad(ir)
139 373406 : sum = sum + rhoz%r_coef(ir)*grid_atom%wr(ir)
140 : END DO
141 7242 : rhoz%one_atom = sum*harmonics%slm_int(1)
142 7242 : rhoz_tot = rhoz_tot + natom*rhoz%one_atom
143 :
144 7242 : END SUBROUTINE calculate_rhoz
145 :
146 : ! **************************************************************************************************
147 : !> \brief ...
148 : !> \param rhoz_set ...
149 : ! **************************************************************************************************
150 3626 : SUBROUTINE deallocate_rhoz(rhoz_set)
151 :
152 : TYPE(rhoz_type), DIMENSION(:), POINTER :: rhoz_set
153 :
154 : INTEGER :: ikind, nkind
155 :
156 3626 : nkind = SIZE(rhoz_set)
157 :
158 10876 : DO ikind = 1, nkind
159 7250 : IF (ASSOCIATED(rhoz_set(ikind)%r_coef)) DEALLOCATE (rhoz_set(ikind)%r_coef)
160 7250 : IF (ASSOCIATED(rhoz_set(ikind)%dr_coef)) DEALLOCATE (rhoz_set(ikind)%dr_coef)
161 10876 : IF (ASSOCIATED(rhoz_set(ikind)%vr_coef)) DEALLOCATE (rhoz_set(ikind)%vr_coef)
162 : END DO
163 :
164 3626 : DEALLOCATE (rhoz_set)
165 :
166 3626 : END SUBROUTINE deallocate_rhoz
167 :
168 : ! **************************************************************************************************
169 : !> \brief ...
170 : !> \param local_rho_set ...
171 : !> \param rho_atom_set ...
172 : !> \param rho0_atom_set ...
173 : !> \param rho0_mpole ...
174 : !> \param rhoz_set ...
175 : !> \param rhoz_cneo_set ...
176 : ! **************************************************************************************************
177 459851 : SUBROUTINE get_local_rho(local_rho_set, rho_atom_set, rho0_atom_set, rho0_mpole, rhoz_set, &
178 : rhoz_cneo_set)
179 :
180 : TYPE(local_rho_type), POINTER :: local_rho_set
181 : TYPE(rho_atom_type), DIMENSION(:), OPTIONAL, &
182 : POINTER :: rho_atom_set
183 : TYPE(rho0_atom_type), DIMENSION(:), OPTIONAL, &
184 : POINTER :: rho0_atom_set
185 : TYPE(rho0_mpole_type), OPTIONAL, POINTER :: rho0_mpole
186 : TYPE(rhoz_type), DIMENSION(:), OPTIONAL, POINTER :: rhoz_set
187 : TYPE(rhoz_cneo_type), DIMENSION(:), OPTIONAL, &
188 : POINTER :: rhoz_cneo_set
189 :
190 459851 : IF (PRESENT(rho_atom_set)) rho_atom_set => local_rho_set%rho_atom_set
191 459851 : IF (PRESENT(rho0_atom_set)) rho0_atom_set => local_rho_set%rho0_atom_set
192 459851 : IF (PRESENT(rho0_mpole)) rho0_mpole => local_rho_set%rho0_mpole
193 459851 : IF (PRESENT(rhoz_set)) rhoz_set => local_rho_set%rhoz_set
194 459851 : IF (PRESENT(rhoz_cneo_set)) rhoz_cneo_set => local_rho_set%rhoz_cneo_set
195 :
196 459851 : END SUBROUTINE get_local_rho
197 :
198 : ! **************************************************************************************************
199 : !> \brief ...
200 : !> \param local_rho_set ...
201 : ! **************************************************************************************************
202 12718 : SUBROUTINE local_rho_set_create(local_rho_set)
203 :
204 : TYPE(local_rho_type), POINTER :: local_rho_set
205 :
206 12718 : ALLOCATE (local_rho_set)
207 :
208 : NULLIFY (local_rho_set%rho_atom_set)
209 : NULLIFY (local_rho_set%rho0_atom_set)
210 : NULLIFY (local_rho_set%rho0_mpole)
211 : NULLIFY (local_rho_set%rhoz_set)
212 : NULLIFY (local_rho_set%rhoz_cneo_set)
213 :
214 12718 : local_rho_set%rhoz_tot = 0.0_dp
215 12718 : local_rho_set%rhoz_cneo_tot = 0.0_dp
216 :
217 12718 : END SUBROUTINE local_rho_set_create
218 :
219 : ! **************************************************************************************************
220 : !> \brief ...
221 : !> \param local_rho_set ...
222 : ! **************************************************************************************************
223 12718 : SUBROUTINE local_rho_set_release(local_rho_set)
224 :
225 : TYPE(local_rho_type), POINTER :: local_rho_set
226 :
227 12718 : IF (ASSOCIATED(local_rho_set)) THEN
228 12718 : IF (ASSOCIATED(local_rho_set%rho_atom_set)) THEN
229 5410 : CALL deallocate_rho_atom_set(local_rho_set%rho_atom_set)
230 : END IF
231 :
232 12718 : IF (ASSOCIATED(local_rho_set%rho0_atom_set)) THEN
233 3626 : CALL deallocate_rho0_atom(local_rho_set%rho0_atom_set)
234 : END IF
235 :
236 12718 : IF (ASSOCIATED(local_rho_set%rho0_mpole)) THEN
237 3626 : CALL deallocate_rho0_mpole(local_rho_set%rho0_mpole)
238 : END IF
239 :
240 12718 : IF (ASSOCIATED(local_rho_set%rhoz_set)) THEN
241 3626 : CALL deallocate_rhoz(local_rho_set%rhoz_set)
242 : END IF
243 :
244 12718 : IF (ASSOCIATED(local_rho_set%rhoz_cneo_set)) THEN
245 8 : CALL deallocate_rhoz_cneo_set(local_rho_set%rhoz_cneo_set)
246 : END IF
247 :
248 12718 : DEALLOCATE (local_rho_set)
249 : END IF
250 :
251 12718 : END SUBROUTINE local_rho_set_release
252 :
253 : ! **************************************************************************************************
254 : !> \brief ...
255 : !> \param local_rho_set ...
256 : !> \param rho_atom_set ...
257 : !> \param rho0_atom_set ...
258 : !> \param rho0_mpole ...
259 : !> \param rhoz_set ...
260 : !> \param rhoz_cneo_set ...
261 : ! **************************************************************************************************
262 4982 : SUBROUTINE set_local_rho(local_rho_set, rho_atom_set, rho0_atom_set, rho0_mpole, &
263 : rhoz_set, rhoz_cneo_set)
264 :
265 : TYPE(local_rho_type), POINTER :: local_rho_set
266 : TYPE(rho_atom_type), DIMENSION(:), OPTIONAL, &
267 : POINTER :: rho_atom_set
268 : TYPE(rho0_atom_type), DIMENSION(:), OPTIONAL, &
269 : POINTER :: rho0_atom_set
270 : TYPE(rho0_mpole_type), OPTIONAL, POINTER :: rho0_mpole
271 : TYPE(rhoz_type), DIMENSION(:), OPTIONAL, POINTER :: rhoz_set
272 : TYPE(rhoz_cneo_type), DIMENSION(:), OPTIONAL, &
273 : POINTER :: rhoz_cneo_set
274 :
275 4982 : IF (PRESENT(rho_atom_set)) THEN
276 1356 : IF (ASSOCIATED(local_rho_set%rho_atom_set)) THEN
277 0 : CALL deallocate_rho_atom_set(local_rho_set%rho_atom_set)
278 : END IF
279 1356 : local_rho_set%rho_atom_set => rho_atom_set
280 : END IF
281 :
282 4982 : IF (PRESENT(rho0_atom_set)) THEN
283 3626 : IF (ASSOCIATED(local_rho_set%rho0_atom_set)) THEN
284 0 : CALL deallocate_rho0_atom(local_rho_set%rho0_atom_set)
285 : END IF
286 3626 : local_rho_set%rho0_atom_set => rho0_atom_set
287 : END IF
288 :
289 4982 : IF (PRESENT(rho0_mpole)) THEN
290 3626 : IF (ASSOCIATED(local_rho_set%rho0_mpole)) THEN
291 0 : CALL deallocate_rho0_mpole(local_rho_set%rho0_mpole)
292 : END IF
293 3626 : local_rho_set%rho0_mpole => rho0_mpole
294 : END IF
295 :
296 4982 : IF (PRESENT(rhoz_set)) THEN
297 3626 : IF (ASSOCIATED(local_rho_set%rhoz_set)) THEN
298 0 : CALL deallocate_rhoz(local_rho_set%rhoz_set)
299 : END IF
300 3626 : local_rho_set%rhoz_set => rhoz_set
301 : END IF
302 :
303 4982 : IF (PRESENT(rhoz_cneo_set)) THEN
304 3626 : IF (ASSOCIATED(local_rho_set%rhoz_cneo_set)) THEN
305 0 : CALL deallocate_rhoz_cneo_set(local_rho_set%rhoz_cneo_set)
306 : END IF
307 3626 : local_rho_set%rhoz_cneo_set => rhoz_cneo_set
308 : END IF
309 :
310 4982 : END SUBROUTINE set_local_rho
311 :
312 0 : END MODULE qs_local_rho_types
|
