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