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 : !
75 : LOGICAL :: rho_g_valid = .FALSE., &
76 : rho_r_valid = .FALSE., &
77 : drho_r_valid = .FALSE., &
78 : drho_g_valid = .FALSE., &
79 : tau_r_valid = .FALSE., &
80 : tau_g_valid = .FALSE., &
81 : soft_valid = .FALSE., &
82 : complex_rho_ao = .FALSE.
83 : !
84 : REAL(KIND=dp), DIMENSION(:), POINTER :: tot_rho_r => Null(), &
85 : tot_rho_g => Null()
86 : END TYPE qs_rho_type
87 :
88 : ! **************************************************************************************************
89 : TYPE qs_rho_p_type
90 : TYPE(qs_rho_type), POINTER :: rho => NULL()
91 : END TYPE qs_rho_p_type
92 :
93 : CONTAINS
94 :
95 : ! **************************************************************************************************
96 : !> \brief Allocates a new instance of rho.
97 : !> \param rho ...
98 : !> \author Ole Schuett
99 : ! **************************************************************************************************
100 34664 : SUBROUTINE qs_rho_create(rho)
101 : TYPE(qs_rho_type), INTENT(OUT) :: rho
102 :
103 34664 : END SUBROUTINE qs_rho_create
104 :
105 : ! **************************************************************************************************
106 : !> \brief releases a rho_struct by decreasing the reference count by one
107 : !> and deallocating if it reaches 0 (to be called when you don't want
108 : !> anymore a shared copy)
109 : !> \param rho_struct the structure to retain
110 : !> \par History
111 : !> 08.2002 created [fawzi]
112 : !> \author Fawzi Mohamed
113 : ! **************************************************************************************************
114 33670 : SUBROUTINE qs_rho_release(rho_struct)
115 : TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
116 :
117 33670 : CALL qs_rho_clear(rho_struct)
118 :
119 33670 : END SUBROUTINE qs_rho_release
120 :
121 : ! **************************************************************************************************
122 : !> \brief Deallocates all components, without deallocating rho_struct itself.
123 : !> \param rho_struct ...
124 : !> \author Ole Schuett
125 : ! **************************************************************************************************
126 47374 : SUBROUTINE qs_rho_clear(rho_struct)
127 : TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
128 :
129 : INTEGER :: i, j
130 :
131 47374 : IF (ASSOCIATED(rho_struct%rho_r)) THEN
132 56057 : DO i = 1, SIZE(rho_struct%rho_r)
133 56057 : CALL rho_struct%rho_r(i)%release()
134 : END DO
135 25310 : DEALLOCATE (rho_struct%rho_r)
136 : END IF
137 47374 : IF (ASSOCIATED(rho_struct%drho_r)) THEN
138 0 : DO j = 1, SIZE(rho_struct%drho_r, 2)
139 0 : DO i = 1, SIZE(rho_struct%drho_r, 1)
140 0 : CALL rho_struct%drho_r(i, j)%release()
141 : END DO
142 : END DO
143 0 : DEALLOCATE (rho_struct%drho_r)
144 : END IF
145 47374 : IF (ASSOCIATED(rho_struct%drho_g)) THEN
146 0 : DO i = 1, SIZE(rho_struct%drho_g, 2)
147 0 : DO j = 1, SIZE(rho_struct%drho_g, 1)
148 0 : CALL rho_struct%drho_g(i, j)%release()
149 : END DO
150 : END DO
151 0 : DEALLOCATE (rho_struct%drho_g)
152 : END IF
153 47374 : IF (ASSOCIATED(rho_struct%tau_r)) THEN
154 548 : DO i = 1, SIZE(rho_struct%tau_r)
155 548 : CALL rho_struct%tau_r(i)%release()
156 : END DO
157 252 : DEALLOCATE (rho_struct%tau_r)
158 : END IF
159 47374 : IF (ASSOCIATED(rho_struct%rho_g)) THEN
160 56057 : DO i = 1, SIZE(rho_struct%rho_g)
161 56057 : CALL rho_struct%rho_g(i)%release()
162 : END DO
163 25310 : DEALLOCATE (rho_struct%rho_g)
164 : END IF
165 47374 : IF (ASSOCIATED(rho_struct%tau_g)) THEN
166 548 : DO i = 1, SIZE(rho_struct%tau_g)
167 548 : CALL rho_struct%tau_g(i)%release()
168 : END DO
169 252 : DEALLOCATE (rho_struct%tau_g)
170 : END IF
171 47374 : IF (ASSOCIATED(rho_struct%rho_r_sccs)) THEN
172 10 : CALL rho_struct%rho_r_sccs%release()
173 10 : DEALLOCATE (rho_struct%rho_r_sccs)
174 : END IF
175 :
176 47374 : CALL kpoint_transitional_release(rho_struct%rho_ao)
177 :
178 47374 : CALL kpoint_transitional_release(rho_struct%rho_ao_im)
179 :
180 47374 : IF (ASSOCIATED(rho_struct%tot_rho_r)) DEALLOCATE (rho_struct%tot_rho_r)
181 47374 : IF (ASSOCIATED(rho_struct%tot_rho_g)) DEALLOCATE (rho_struct%tot_rho_g)
182 :
183 47374 : 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 1741180 : 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 1741180 : IF (PRESENT(rho_ao)) rho_ao => get_1d_pointer(rho_struct%rho_ao)
253 1741180 : IF (PRESENT(rho_ao_kp)) rho_ao_kp => get_2d_pointer(rho_struct%rho_ao)
254 :
255 1741180 : IF (PRESENT(rho_ao_im)) rho_ao_im => get_1d_pointer(rho_struct%rho_ao_im)
256 1741180 : IF (PRESENT(rho_ao_im_kp)) rho_ao_im_kp => get_2d_pointer(rho_struct%rho_ao_im)
257 :
258 1741180 : IF (PRESENT(rho_r)) rho_r => rho_struct%rho_r
259 1741180 : IF (PRESENT(drho_r)) drho_r => rho_struct%drho_r
260 1741180 : IF (PRESENT(rho_g)) rho_g => rho_struct%rho_g
261 1741180 : IF (PRESENT(drho_g)) drho_g => rho_struct%drho_g
262 1741180 : IF (PRESENT(tau_r)) tau_r => rho_struct%tau_r
263 1741180 : IF (PRESENT(tau_g)) tau_g => rho_struct%tau_g
264 1741180 : IF (PRESENT(rho_r_valid)) rho_r_valid = rho_struct%rho_r_valid
265 1741180 : IF (PRESENT(rho_g_valid)) rho_g_valid = rho_struct%rho_g_valid
266 1741180 : IF (PRESENT(drho_r_valid)) drho_r_valid = rho_struct%drho_r_valid
267 1741180 : IF (PRESENT(drho_g_valid)) drho_g_valid = rho_struct%drho_g_valid
268 1741180 : IF (PRESENT(tau_r_valid)) tau_r_valid = rho_struct%tau_r_valid
269 1741180 : IF (PRESENT(tau_g_valid)) tau_g_valid = rho_struct%tau_g_valid
270 1741180 : IF (PRESENT(soft_valid)) soft_valid = rho_struct%soft_valid
271 1741180 : IF (PRESENT(tot_rho_r)) tot_rho_r => rho_struct%tot_rho_r
272 1741180 : IF (PRESENT(tot_rho_g)) tot_rho_g => rho_struct%tot_rho_g
273 1741180 : IF (PRESENT(rho_r_sccs)) rho_r_sccs => rho_struct%rho_r_sccs
274 1741180 : IF (PRESENT(complex_rho_ao)) complex_rho_ao = rho_struct%complex_rho_ao
275 :
276 1741180 : 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 381709 : 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 381709 : IF (PRESENT(rho_ao)) CALL set_1d_pointer(rho_struct%rho_ao, rho_ao)
332 381709 : IF (PRESENT(rho_ao_kp)) CALL set_2d_pointer(rho_struct%rho_ao, rho_ao_kp)
333 :
334 381709 : IF (PRESENT(rho_ao_im)) CALL set_1d_pointer(rho_struct%rho_ao_im, rho_ao_im)
335 381709 : IF (PRESENT(rho_ao_im_kp)) CALL set_2d_pointer(rho_struct%rho_ao_im, rho_ao_im_kp)
336 :
337 381709 : IF (PRESENT(rho_r)) rho_struct%rho_r => rho_r
338 381709 : IF (PRESENT(rho_g)) rho_struct%rho_g => rho_g
339 381709 : IF (PRESENT(drho_r)) rho_struct%drho_r => drho_r
340 381709 : IF (PRESENT(drho_g)) rho_struct%drho_g => drho_g
341 381709 : IF (PRESENT(tau_r)) rho_struct%tau_r => tau_r
342 381709 : IF (PRESENT(tau_g)) rho_struct%tau_g => tau_g
343 381709 : IF (PRESENT(rho_r_valid)) rho_struct%rho_r_valid = rho_r_valid
344 381709 : IF (PRESENT(rho_g_valid)) rho_struct%rho_g_valid = rho_g_valid
345 381709 : IF (PRESENT(drho_r_valid)) rho_struct%drho_r_valid = drho_r_valid
346 381709 : IF (PRESENT(drho_g_valid)) rho_struct%drho_g_valid = drho_g_valid
347 381709 : IF (PRESENT(tau_r_valid)) rho_struct%tau_r_valid = tau_r_valid
348 381709 : IF (PRESENT(tau_g_valid)) rho_struct%tau_g_valid = tau_g_valid
349 381709 : IF (PRESENT(soft_valid)) rho_struct%soft_valid = soft_valid
350 381709 : IF (PRESENT(tot_rho_r)) rho_struct%tot_rho_r => tot_rho_r
351 381709 : IF (PRESENT(tot_rho_g)) rho_struct%tot_rho_g => tot_rho_g
352 381709 : IF (PRESENT(rho_r_sccs)) rho_struct%rho_r_sccs => rho_r_sccs
353 381709 : IF (PRESENT(complex_rho_ao)) rho_struct%complex_rho_ao = complex_rho_ao
354 :
355 381709 : 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
|