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 : ! **************************************************************************************************
9 : !> \brief superstucture that hold various representations of the density and
10 : !> keeps track of which ones are valid
11 : !> \par History
12 : !> 08.2002 created [fawzi]
13 : !> 08.2014 kpoints [JGH]
14 : !> 11.2014 make qs_rho_type PRIVATE [Ole Schuett]
15 : !> 11.2014 unified k-point and gamma-point code [Ole Schuett]
16 : !> \author Fawzi Mohamed
17 : ! **************************************************************************************************
18 : MODULE qs_rho_types
19 : USE cp_dbcsr_api, ONLY: dbcsr_p_type
20 : USE kinds, ONLY: dp
21 : USE kpoint_transitional, ONLY: get_1d_pointer,&
22 : get_2d_pointer,&
23 : kpoint_transitional_release,&
24 : kpoint_transitional_type,&
25 : set_1d_pointer,&
26 : set_2d_pointer
27 : USE pw_pool_types, ONLY: pw_pool_type
28 : USE pw_types, ONLY: pw_c1d_gs_type,&
29 : pw_r3d_rs_type
30 : #include "./base/base_uses.f90"
31 :
32 : IMPLICIT NONE
33 : PRIVATE
34 :
35 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
36 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_rho_types'
37 :
38 : PUBLIC :: qs_rho_p_type, qs_rho_type
39 : PUBLIC :: qs_rho_release, qs_rho_clear_pwpool, &
40 : qs_rho_get, qs_rho_set, qs_rho_clear, qs_rho_create, qs_rho_unset_rho_ao
41 :
42 : ! **************************************************************************************************
43 : !> \brief keeps the density in various representations, keeping track of
44 : !> which ones are valid.
45 : !> \param most attributes are array with either lda or lsd_alpha,lsd_beta.
46 : !> \param rho_ao the filtered rho in the localized atom basis (to have rho(r)
47 : !> the filtered matrix is enough, but rho(r,r') is lost).
48 : !> \param rho_ao_kp the filtered rho in the localized atom basis (to have rho(r)
49 : !> the filtered matrix is enough, but rho(r,r') is lost).
50 : !> for kpoints, in real space index form
51 : !> \param rho_r grids with rho in the real space
52 : !> \param tau_r grids with the kinetic energy density in real space
53 : !> \param rho_g grids with rho in the g space
54 : !> \param tau_g grids with the kinetic energy density in g space
55 : !> \param rho_g_valid , rho_r_valid, tau_r_valid, tau_g_valid: if the
56 : !> corresponding component is valid
57 : !> \param tot_rho_r the total charge in r space (valid only if rho_r is)
58 : !> \par History
59 : !> 08.2002 created [fawzi]
60 : !> \author Fawzi Mohamed
61 : ! **************************************************************************************************
62 : TYPE qs_rho_type
63 : PRIVATE
64 : TYPE(kpoint_transitional_type) :: rho_ao = kpoint_transitional_type()
65 : TYPE(kpoint_transitional_type) :: rho_ao_im = kpoint_transitional_type()
66 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r => Null()
67 : TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g => Null()
68 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: tau_r => Null()
69 : TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: tau_g => Null()
70 : TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r => NULL()
71 : TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g => NULL()
72 : ! Final rho_iter of last SCCS cycle (r-space)
73 : TYPE(pw_r3d_rs_type), POINTER :: rho_r_sccs => Null()
74 : LOGICAL :: rho_g_valid = .FALSE., &
75 : rho_r_valid = .FALSE., &
76 : drho_r_valid = .FALSE., &
77 : drho_g_valid = .FALSE., &
78 : tau_r_valid = .FALSE., &
79 : tau_g_valid = .FALSE., &
80 : soft_valid = .FALSE., &
81 : complex_rho_ao = .FALSE.
82 : REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_r => Null(), &
83 : tot_rho_g => Null()
84 : END TYPE qs_rho_type
85 :
86 : ! **************************************************************************************************
87 : TYPE qs_rho_p_type
88 : TYPE(qs_rho_type), POINTER :: rho => NULL()
89 : END TYPE qs_rho_p_type
90 :
91 : CONTAINS
92 :
93 : ! **************************************************************************************************
94 : !> \brief Allocates a new instance of rho.
95 : !> \param rho ...
96 : !> \author Ole Schuett
97 : ! **************************************************************************************************
98 33002 : SUBROUTINE qs_rho_create(rho)
99 : TYPE(qs_rho_type), INTENT(OUT) :: rho
100 :
101 33002 : END SUBROUTINE qs_rho_create
102 :
103 : ! **************************************************************************************************
104 : !> \brief releases a rho_struct by decreasing the reference count by one
105 : !> and deallocating if it reaches 0 (to be called when you don't want
106 : !> anymore a shared copy)
107 : !> \param rho_struct the structure to retain
108 : !> \par History
109 : !> 08.2002 created [fawzi]
110 : !> \author Fawzi Mohamed
111 : ! **************************************************************************************************
112 32008 : SUBROUTINE qs_rho_release(rho_struct)
113 : TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
114 :
115 32008 : CALL qs_rho_clear(rho_struct)
116 :
117 32008 : END SUBROUTINE qs_rho_release
118 :
119 : ! **************************************************************************************************
120 : !> \brief Deallocates all components, without deallocating rho_struct itself.
121 : !> \param rho_struct ...
122 : !> \author Ole Schuett
123 : ! **************************************************************************************************
124 45712 : SUBROUTINE qs_rho_clear(rho_struct)
125 : TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
126 :
127 : INTEGER :: i, j
128 :
129 45712 : IF (ASSOCIATED(rho_struct%rho_r)) THEN
130 54087 : DO i = 1, SIZE(rho_struct%rho_r)
131 54087 : CALL rho_struct%rho_r(i)%release()
132 : END DO
133 24416 : DEALLOCATE (rho_struct%rho_r)
134 : END IF
135 45712 : IF (ASSOCIATED(rho_struct%drho_r)) THEN
136 0 : DO j = 1, SIZE(rho_struct%drho_r, 2)
137 0 : DO i = 1, SIZE(rho_struct%drho_r, 1)
138 0 : CALL rho_struct%drho_r(i, j)%release()
139 : END DO
140 : END DO
141 0 : DEALLOCATE (rho_struct%drho_r)
142 : END IF
143 45712 : IF (ASSOCIATED(rho_struct%drho_g)) THEN
144 0 : DO i = 1, SIZE(rho_struct%drho_g, 2)
145 0 : DO j = 1, SIZE(rho_struct%drho_g, 1)
146 0 : CALL rho_struct%drho_g(i, j)%release()
147 : END DO
148 : END DO
149 0 : DEALLOCATE (rho_struct%drho_g)
150 : END IF
151 45712 : IF (ASSOCIATED(rho_struct%tau_r)) THEN
152 528 : DO i = 1, SIZE(rho_struct%tau_r)
153 528 : CALL rho_struct%tau_r(i)%release()
154 : END DO
155 244 : DEALLOCATE (rho_struct%tau_r)
156 : END IF
157 45712 : IF (ASSOCIATED(rho_struct%rho_g)) THEN
158 54087 : DO i = 1, SIZE(rho_struct%rho_g)
159 54087 : CALL rho_struct%rho_g(i)%release()
160 : END DO
161 24416 : DEALLOCATE (rho_struct%rho_g)
162 : END IF
163 45712 : IF (ASSOCIATED(rho_struct%tau_g)) THEN
164 528 : DO i = 1, SIZE(rho_struct%tau_g)
165 528 : CALL rho_struct%tau_g(i)%release()
166 : END DO
167 244 : DEALLOCATE (rho_struct%tau_g)
168 : END IF
169 45712 : IF (ASSOCIATED(rho_struct%rho_r_sccs)) THEN
170 10 : CALL rho_struct%rho_r_sccs%release()
171 10 : DEALLOCATE (rho_struct%rho_r_sccs)
172 : END IF
173 :
174 45712 : CALL kpoint_transitional_release(rho_struct%rho_ao)
175 :
176 45712 : CALL kpoint_transitional_release(rho_struct%rho_ao_im)
177 :
178 45712 : IF (ASSOCIATED(rho_struct%tot_rho_r)) &
179 23684 : DEALLOCATE (rho_struct%tot_rho_r)
180 45712 : IF (ASSOCIATED(rho_struct%tot_rho_g)) &
181 0 : DEALLOCATE (rho_struct%tot_rho_g)
182 :
183 45712 : END SUBROUTINE qs_rho_clear
184 :
185 : ! **************************************************************************************************
186 : !> \brief Unsets the rho_ao / rho_ao_kp field without calling kpoint_transitional_release().
187 : !> \param rho_struct ...
188 : !> \author Ole Schuett
189 : ! **************************************************************************************************
190 722 : SUBROUTINE qs_rho_unset_rho_ao(rho_struct)
191 : TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
192 :
193 722 : rho_struct%rho_ao = kpoint_transitional_type()
194 722 : END SUBROUTINE qs_rho_unset_rho_ao
195 :
196 : ! **************************************************************************************************
197 : !> \brief returns info about the density described by this object.
198 : !> If some representation is not available an error is issued
199 : !> \param rho_struct ...
200 : !> \param rho_ao ...
201 : !> \param rho_ao_im ...
202 : !> \param rho_ao_kp ...
203 : !> \param rho_ao_im_kp ...
204 : !> \param rho_r ...
205 : !> \param drho_r ...
206 : !> \param rho_g ...
207 : !> \param drho_g ...
208 : !> \param tau_r ...
209 : !> \param tau_g ...
210 : !> \param rho_r_valid ...
211 : !> \param drho_r_valid ...
212 : !> \param rho_g_valid ...
213 : !> \param drho_g_valid ...
214 : !> \param tau_r_valid ...
215 : !> \param tau_g_valid ...
216 : !> \param tot_rho_r ...
217 : !> \param tot_rho_g ...
218 : !> \param rho_r_sccs ...
219 : !> \param soft_valid ...
220 : !> \param complex_rho_ao ...
221 : !> \par History
222 : !> 08.2002 created [fawzi]
223 : !> \author Fawzi Mohamed
224 : ! **************************************************************************************************
225 1730543 : SUBROUTINE qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, &
226 : rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, &
227 : drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, &
228 : rho_r_sccs, soft_valid, complex_rho_ao)
229 : TYPE(qs_rho_type), INTENT(IN) :: rho_struct
230 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
231 : POINTER :: rho_ao, rho_ao_im
232 : TYPE(dbcsr_p_type), DIMENSION(:, :), OPTIONAL, &
233 : POINTER :: rho_ao_kp, rho_ao_im_kp
234 : TYPE(pw_r3d_rs_type), DIMENSION(:), OPTIONAL, &
235 : POINTER :: rho_r
236 : TYPE(pw_r3d_rs_type), DIMENSION(:, :), OPTIONAL, &
237 : POINTER :: drho_r
238 : TYPE(pw_c1d_gs_type), DIMENSION(:), OPTIONAL, &
239 : POINTER :: rho_g
240 : TYPE(pw_c1d_gs_type), DIMENSION(:, :), OPTIONAL, &
241 : POINTER :: drho_g
242 : TYPE(pw_r3d_rs_type), DIMENSION(:), OPTIONAL, &
243 : POINTER :: tau_r
244 : TYPE(pw_c1d_gs_type), DIMENSION(:), OPTIONAL, &
245 : POINTER :: tau_g
246 : LOGICAL, INTENT(out), OPTIONAL :: rho_r_valid, drho_r_valid, rho_g_valid, &
247 : drho_g_valid, tau_r_valid, tau_g_valid
248 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: tot_rho_r, tot_rho_g
249 : TYPE(pw_r3d_rs_type), OPTIONAL, POINTER :: rho_r_sccs
250 : LOGICAL, INTENT(out), OPTIONAL :: soft_valid, complex_rho_ao
251 :
252 1730543 : IF (PRESENT(rho_ao)) rho_ao => get_1d_pointer(rho_struct%rho_ao)
253 1730543 : IF (PRESENT(rho_ao_kp)) rho_ao_kp => get_2d_pointer(rho_struct%rho_ao)
254 :
255 1730543 : IF (PRESENT(rho_ao_im)) rho_ao_im => get_1d_pointer(rho_struct%rho_ao_im)
256 1730543 : IF (PRESENT(rho_ao_im_kp)) rho_ao_im_kp => get_2d_pointer(rho_struct%rho_ao_im)
257 :
258 1730543 : IF (PRESENT(rho_r)) rho_r => rho_struct%rho_r
259 1730543 : IF (PRESENT(drho_r)) drho_r => rho_struct%drho_r
260 1730543 : IF (PRESENT(rho_g)) rho_g => rho_struct%rho_g
261 1730543 : IF (PRESENT(drho_g)) drho_g => rho_struct%drho_g
262 1730543 : IF (PRESENT(tau_r)) tau_r => rho_struct%tau_r
263 1730543 : IF (PRESENT(tau_g)) tau_g => rho_struct%tau_g
264 1730543 : IF (PRESENT(rho_r_valid)) rho_r_valid = rho_struct%rho_r_valid
265 1730543 : IF (PRESENT(rho_g_valid)) rho_g_valid = rho_struct%rho_g_valid
266 1730543 : IF (PRESENT(drho_r_valid)) drho_r_valid = rho_struct%drho_r_valid
267 1730543 : IF (PRESENT(drho_g_valid)) drho_g_valid = rho_struct%drho_g_valid
268 1730543 : IF (PRESENT(tau_r_valid)) tau_r_valid = rho_struct%tau_r_valid
269 1730543 : IF (PRESENT(tau_g_valid)) tau_g_valid = rho_struct%tau_g_valid
270 1730543 : IF (PRESENT(soft_valid)) soft_valid = rho_struct%soft_valid
271 1730543 : IF (PRESENT(tot_rho_r)) tot_rho_r => rho_struct%tot_rho_r
272 1730543 : IF (PRESENT(tot_rho_g)) tot_rho_g => rho_struct%tot_rho_g
273 1730543 : IF (PRESENT(rho_r_sccs)) rho_r_sccs => rho_struct%rho_r_sccs
274 1730543 : IF (PRESENT(complex_rho_ao)) complex_rho_ao = rho_struct%complex_rho_ao
275 :
276 1730543 : END SUBROUTINE qs_rho_get
277 :
278 : ! **************************************************************************************************
279 : !> \brief ...
280 : !> \param rho_struct ...
281 : !> \param rho_ao ...
282 : !> \param rho_ao_im ...
283 : !> \param rho_ao_kp ...
284 : !> \param rho_ao_im_kp ...
285 : !> \param rho_r ...
286 : !> \param drho_r ...
287 : !> \param rho_g ...
288 : !> \param drho_g ...
289 : !> \param tau_r ...
290 : !> \param tau_g ...
291 : !> \param rho_r_valid ...
292 : !> \param drho_r_valid ...
293 : !> \param rho_g_valid ...
294 : !> \param drho_g_valid ...
295 : !> \param tau_r_valid ...
296 : !> \param tau_g_valid ...
297 : !> \param tot_rho_r ...
298 : !> \param tot_rho_g ...
299 : !> \param rho_r_sccs ...
300 : !> \param soft_valid ...
301 : !> \param complex_rho_ao ...
302 : !> \author Ole Schuett
303 : ! **************************************************************************************************
304 375569 : SUBROUTINE qs_rho_set(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, &
305 : rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, &
306 : drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, &
307 : rho_r_sccs, soft_valid, complex_rho_ao)
308 : TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
309 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
310 : POINTER :: rho_ao, rho_ao_im
311 : TYPE(dbcsr_p_type), DIMENSION(:, :), OPTIONAL, &
312 : POINTER :: rho_ao_kp, rho_ao_im_kp
313 : TYPE(pw_r3d_rs_type), DIMENSION(:), OPTIONAL, &
314 : POINTER :: rho_r
315 : TYPE(pw_r3d_rs_type), DIMENSION(:, :), OPTIONAL, &
316 : POINTER :: drho_r
317 : TYPE(pw_c1d_gs_type), DIMENSION(:), OPTIONAL, &
318 : POINTER :: rho_g
319 : TYPE(pw_c1d_gs_type), DIMENSION(:, :), OPTIONAL, &
320 : POINTER :: drho_g
321 : TYPE(pw_r3d_rs_type), DIMENSION(:), OPTIONAL, &
322 : POINTER :: tau_r
323 : TYPE(pw_c1d_gs_type), DIMENSION(:), OPTIONAL, &
324 : POINTER :: tau_g
325 : LOGICAL, INTENT(in), OPTIONAL :: rho_r_valid, drho_r_valid, rho_g_valid, &
326 : drho_g_valid, tau_r_valid, tau_g_valid
327 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: tot_rho_r, tot_rho_g
328 : TYPE(pw_r3d_rs_type), OPTIONAL, POINTER :: rho_r_sccs
329 : LOGICAL, INTENT(in), OPTIONAL :: soft_valid, complex_rho_ao
330 :
331 375569 : IF (PRESENT(rho_ao)) CALL set_1d_pointer(rho_struct%rho_ao, rho_ao)
332 375569 : IF (PRESENT(rho_ao_kp)) CALL set_2d_pointer(rho_struct%rho_ao, rho_ao_kp)
333 :
334 375569 : IF (PRESENT(rho_ao_im)) CALL set_1d_pointer(rho_struct%rho_ao_im, rho_ao_im)
335 375569 : IF (PRESENT(rho_ao_im_kp)) CALL set_2d_pointer(rho_struct%rho_ao_im, rho_ao_im_kp)
336 :
337 375569 : IF (PRESENT(rho_r)) rho_struct%rho_r => rho_r
338 375569 : IF (PRESENT(rho_g)) rho_struct%rho_g => rho_g
339 375569 : IF (PRESENT(drho_r)) rho_struct%drho_r => drho_r
340 375569 : IF (PRESENT(drho_g)) rho_struct%drho_g => drho_g
341 375569 : IF (PRESENT(tau_r)) rho_struct%tau_r => tau_r
342 375569 : IF (PRESENT(tau_g)) rho_struct%tau_g => tau_g
343 375569 : IF (PRESENT(rho_r_valid)) rho_struct%rho_r_valid = rho_r_valid
344 375569 : IF (PRESENT(rho_g_valid)) rho_struct%rho_g_valid = rho_g_valid
345 375569 : IF (PRESENT(drho_r_valid)) rho_struct%drho_r_valid = drho_r_valid
346 375569 : IF (PRESENT(drho_g_valid)) rho_struct%drho_g_valid = drho_g_valid
347 375569 : IF (PRESENT(tau_r_valid)) rho_struct%tau_r_valid = tau_r_valid
348 375569 : IF (PRESENT(tau_g_valid)) rho_struct%tau_g_valid = tau_g_valid
349 375569 : IF (PRESENT(soft_valid)) rho_struct%soft_valid = soft_valid
350 375569 : IF (PRESENT(tot_rho_r)) rho_struct%tot_rho_r => tot_rho_r
351 375569 : IF (PRESENT(tot_rho_g)) rho_struct%tot_rho_g => tot_rho_g
352 375569 : IF (PRESENT(rho_r_sccs)) rho_struct%rho_r_sccs => rho_r_sccs
353 375569 : IF (PRESENT(complex_rho_ao)) rho_struct%complex_rho_ao = complex_rho_ao
354 :
355 375569 : END SUBROUTINE qs_rho_set
356 : ! **************************************************************************************************
357 : !> \brief ...
358 : !> \param rho_struct ...
359 : !> \param auxbas_pw_pool ...
360 : ! **************************************************************************************************
361 0 : SUBROUTINE qs_rho_clear_pwpool(rho_struct, auxbas_pw_pool)
362 : TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
363 : TYPE(pw_pool_type), INTENT(IN), POINTER :: auxbas_pw_pool
364 :
365 : INTEGER :: i
366 :
367 0 : IF (ASSOCIATED(rho_struct%rho_r)) THEN
368 0 : DO i = 1, SIZE(rho_struct%rho_r)
369 0 : CALL auxbas_pw_pool%give_back_pw(rho_struct%rho_r(i))
370 : END DO
371 0 : DEALLOCATE (rho_struct%rho_r)
372 : NULLIFY (rho_struct%rho_r)
373 : END IF
374 0 : IF (ASSOCIATED(rho_struct%rho_g)) THEN
375 0 : DO i = 1, SIZE(rho_struct%rho_g)
376 0 : CALL auxbas_pw_pool%give_back_pw(rho_struct%rho_g(i))
377 : END DO
378 0 : DEALLOCATE (rho_struct%rho_g)
379 : NULLIFY (rho_struct%rho_g)
380 : END IF
381 :
382 0 : END SUBROUTINE qs_rho_clear_pwpool
383 :
384 0 : END MODULE qs_rho_types
|