(git:e753828)
Loading...
Searching...
No Matches
qs_rho_methods.F
Go to the documentation of this file.
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! **************************************************************************************************
9!> \brief methods of the rho structure (defined in qs_rho_types)
10!> \par History
11!> 08.2002 created [fawzi]
12!> 08.2014 kpoints [JGH]
13!> \author Fawzi Mohamed
14! **************************************************************************************************
15MODULE qs_rho_methods
16 USE admm_types, ONLY: get_admm_env
17 USE atomic_kind_types, ONLY: atomic_kind_type
18 USE cp_control_types, ONLY: dft_control_type
19 USE cp_dbcsr_api, ONLY: &
20 dbcsr_add, dbcsr_copy, dbcsr_create, dbcsr_p_type, dbcsr_scale, dbcsr_set, dbcsr_type, &
21 dbcsr_type_antisymmetric, dbcsr_type_symmetric
22 USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
23 USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
24 dbcsr_deallocate_matrix_set
25 USE cp_log_handling, ONLY: cp_to_string
26 USE kinds, ONLY: default_string_length,&
27 dp
28 USE kpoint_types, ONLY: get_kpoint_info,&
29 kpoint_type
30 USE lri_environment_methods, ONLY: calculate_lri_densities
31 USE lri_environment_types, ONLY: lri_density_type,&
32 lri_environment_type
33 USE message_passing, ONLY: mp_para_env_type
34 USE pw_env_types, ONLY: pw_env_get,&
35 pw_env_type
36 USE pw_methods, ONLY: pw_axpy,&
37 pw_copy,&
38 pw_scale,&
39 pw_transfer,&
40 pw_zero
41 USE pw_pool_types, ONLY: pw_pool_type
42 USE pw_types, ONLY: pw_c1d_gs_type,&
43 pw_r3d_rs_type
44 USE qs_collocate_density, ONLY: calculate_drho_elec,&
45 calculate_rho_elec
46 USE qs_environment_types, ONLY: get_qs_env,&
47 qs_environment_type,&
48 set_qs_env
49 USE qs_harris_types, ONLY: harris_type
50 USE qs_harris_utils, ONLY: calculate_harris_density
51 USE qs_kind_types, ONLY: qs_kind_type
52 USE qs_ks_types, ONLY: get_ks_env,&
53 qs_ks_env_type
54 USE qs_local_rho_types, ONLY: local_rho_type
55 USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
56 USE qs_oce_types, ONLY: oce_matrix_type
57 USE qs_rho_atom_methods, ONLY: calculate_rho_atom_coeff
58 USE qs_rho_atom_types, ONLY: rho_atom_type
59 USE qs_rho_types, ONLY: qs_rho_clear,&
60 qs_rho_get,&
61 qs_rho_set,&
62 qs_rho_type
63 USE ri_environment_methods, ONLY: calculate_ri_densities
64 USE task_list_types, ONLY: task_list_type
65#include "./base/base_uses.f90"
66
67 IMPLICIT NONE
68 PRIVATE
69
70 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
71 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_rho_methods'
72
73 PUBLIC :: qs_rho_update_rho, qs_rho_update_tddfpt, &
74 qs_rho_rebuild, qs_rho_copy, qs_rho_scale_and_add, &
75 qs_rho_scale_and_add_b, qs_rho_transfer
76 PUBLIC :: duplicate_rho_type, allocate_rho_ao_imag_from_real
77
78CONTAINS
79
80! **************************************************************************************************
81!> \brief rebuilds rho (if necessary allocating and initializing it)
82!> \param rho the rho type to rebuild (defaults to qs_env%rho)
83!> \param qs_env the environment to which rho belongs
84!> \param rebuild_ao if it is necessary to rebuild rho_ao. Defaults to true.
85!> \param rebuild_grids if it in necessary to rebuild rho_r and rho_g.
86!> Defaults to false.
87!> \param admm (use aux_fit basis)
88!> \param pw_env_external external plane wave environment
89!> \par History
90!> 11.2002 created replacing qs_rho_create and qs_env_rebuild_rho[fawzi]
91!> \author Fawzi Mohamed
92!> \note
93!> needs updated pw pools, s, s_mstruct and h in qs_env.
94!> The use of p to keep the structure of h (needed for the forces)
95!> is ugly and should be removed.
96!> Change so that it does not allocate a subcomponent if it is not
97!> associated and not requested?
98! **************************************************************************************************
99 SUBROUTINE qs_rho_rebuild(rho, qs_env, rebuild_ao, rebuild_grids, admm, pw_env_external)
100 TYPE(qs_rho_type), INTENT(INOUT) :: rho
101 TYPE(qs_environment_type), POINTER :: qs_env
102 LOGICAL, INTENT(in), OPTIONAL :: rebuild_ao, rebuild_grids, admm
103 TYPE(pw_env_type), OPTIONAL, POINTER :: pw_env_external
104
105 CHARACTER(LEN=*), PARAMETER :: routinen = 'qs_rho_rebuild'
106
107 CHARACTER(LEN=default_string_length) :: headline
108 INTEGER :: handle, i, ic, j, nimg, nspins
109 LOGICAL :: do_kpoints, my_admm, my_rebuild_ao, &
110 my_rebuild_grids, rho_ao_is_complex
111 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_r
112 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s_kp, rho_ao_im_kp, rho_ao_kp
113 TYPE(dbcsr_type), POINTER :: refmatrix, tmatrix
114 TYPE(dft_control_type), POINTER :: dft_control
115 TYPE(kpoint_type), POINTER :: kpoints
116 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
117 POINTER :: sab_orb
118 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g, tau_g
119 TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g
120 TYPE(pw_env_type), POINTER :: pw_env
121 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
122 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, tau_r
123 TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r
124 TYPE(pw_r3d_rs_type), POINTER :: rho_r_sccs
125
126 CALL timeset(routinen, handle)
127
128 NULLIFY (pw_env, auxbas_pw_pool, matrix_s_kp, dft_control)
129 NULLIFY (tot_rho_r, rho_ao_kp, rho_r, rho_g, drho_r, drho_g, tau_r, tau_g, rho_ao_im_kp)
130 NULLIFY (rho_r_sccs)
131 NULLIFY (sab_orb)
132 my_rebuild_ao = .true.
133 my_rebuild_grids = .true.
134 my_admm = .false.
135 IF (PRESENT(rebuild_ao)) my_rebuild_ao = rebuild_ao
136 IF (PRESENT(rebuild_grids)) my_rebuild_grids = rebuild_grids
137 IF (PRESENT(admm)) my_admm = admm
138
139 CALL get_qs_env(qs_env, &
140 kpoints=kpoints, &
141 do_kpoints=do_kpoints, &
142 pw_env=pw_env, &
143 dft_control=dft_control)
144 IF (PRESENT(pw_env_external)) THEN
145 pw_env => pw_env_external
146 END IF
147
148 nimg = dft_control%nimages
149
150 IF (my_admm) THEN
151 CALL get_admm_env(qs_env%admm_env, sab_aux_fit=sab_orb, matrix_s_aux_fit_kp=matrix_s_kp)
152 ELSE
153 CALL get_qs_env(qs_env, matrix_s_kp=matrix_s_kp)
154
155 IF (do_kpoints) THEN
156 CALL get_kpoint_info(kpoints, sab_nl=sab_orb)
157 ELSE
158 CALL get_qs_env(qs_env, sab_orb=sab_orb)
159 END IF
160 END IF
161 refmatrix => matrix_s_kp(1, 1)%matrix
162
163 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
164 nspins = dft_control%nspins
165
166 CALL qs_rho_get(rho, &
167 tot_rho_r=tot_rho_r, &
168 rho_ao_kp=rho_ao_kp, &
169 rho_ao_im_kp=rho_ao_im_kp, &
170 rho_r=rho_r, &
171 rho_g=rho_g, &
172 drho_r=drho_r, &
173 drho_g=drho_g, &
174 tau_r=tau_r, &
175 tau_g=tau_g, &
176 rho_r_sccs=rho_r_sccs, &
177 complex_rho_ao=rho_ao_is_complex)
178
179 IF (.NOT. ASSOCIATED(tot_rho_r)) THEN
180 ALLOCATE (tot_rho_r(nspins))
181 tot_rho_r = 0.0_dp
182 CALL qs_rho_set(rho, tot_rho_r=tot_rho_r)
183 END IF
184
185 ! rho_ao
186 IF (my_rebuild_ao .OR. (.NOT. ASSOCIATED(rho_ao_kp))) THEN
187 IF (ASSOCIATED(rho_ao_kp)) THEN
188 CALL dbcsr_deallocate_matrix_set(rho_ao_kp)
189 END IF
190 ! Create a new density matrix set
191 CALL dbcsr_allocate_matrix_set(rho_ao_kp, nspins, nimg)
192 CALL qs_rho_set(rho, rho_ao_kp=rho_ao_kp)
193 DO i = 1, nspins
194 DO ic = 1, nimg
195 IF (nspins > 1) THEN
196 IF (i == 1) THEN
197 headline = "DENSITY MATRIX FOR ALPHA SPIN"
198 ELSE
199 headline = "DENSITY MATRIX FOR BETA SPIN"
200 END IF
201 ELSE
202 headline = "DENSITY MATRIX"
203 END IF
204 ALLOCATE (rho_ao_kp(i, ic)%matrix)
205 tmatrix => rho_ao_kp(i, ic)%matrix
206 CALL dbcsr_create(matrix=tmatrix, template=refmatrix, name=trim(headline), &
207 matrix_type=dbcsr_type_symmetric)
208 CALL cp_dbcsr_alloc_block_from_nbl(tmatrix, sab_orb)
209 CALL dbcsr_set(tmatrix, 0.0_dp)
210 END DO
211 END DO
212 IF (rho_ao_is_complex) THEN
213 IF (ASSOCIATED(rho_ao_im_kp)) THEN
214 CALL dbcsr_deallocate_matrix_set(rho_ao_im_kp)
215 END IF
216 CALL dbcsr_allocate_matrix_set(rho_ao_im_kp, nspins, nimg)
217 CALL qs_rho_set(rho, rho_ao_im_kp=rho_ao_im_kp)
218 DO i = 1, nspins
219 DO ic = 1, nimg
220 IF (nspins > 1) THEN
221 IF (i == 1) THEN
222 headline = "IMAGINARY PART OF DENSITY MATRIX FOR ALPHA SPIN"
223 ELSE
224 headline = "IMAGINARY PART OF DENSITY MATRIX FOR BETA SPIN"
225 END IF
226 ELSE
227 headline = "IMAGINARY PART OF DENSITY MATRIX"
228 END IF
229 ALLOCATE (rho_ao_im_kp(i, ic)%matrix)
230 tmatrix => rho_ao_im_kp(i, ic)%matrix
231 CALL dbcsr_create(matrix=tmatrix, template=refmatrix, name=trim(headline), &
232 matrix_type=dbcsr_type_antisymmetric)
233 CALL cp_dbcsr_alloc_block_from_nbl(tmatrix, sab_orb)
234 CALL dbcsr_set(tmatrix, 0.0_dp)
235 END DO
236 END DO
237 END IF
238 END IF
239
240 ! rho_r
241 IF (my_rebuild_grids .OR. .NOT. ASSOCIATED(rho_r)) THEN
242 IF (ASSOCIATED(rho_r)) THEN
243 DO i = 1, SIZE(rho_r)
244 CALL rho_r(i)%release()
245 END DO
246 DEALLOCATE (rho_r)
247 END IF
248 ALLOCATE (rho_r(nspins))
249 CALL qs_rho_set(rho, rho_r=rho_r)
250 DO i = 1, nspins
251 CALL auxbas_pw_pool%create_pw(rho_r(i))
252 END DO
253 END IF
254
255 ! rho_g
256 IF (my_rebuild_grids .OR. .NOT. ASSOCIATED(rho_g)) THEN
257 IF (ASSOCIATED(rho_g)) THEN
258 DO i = 1, SIZE(rho_g)
259 CALL rho_g(i)%release()
260 END DO
261 DEALLOCATE (rho_g)
262 END IF
263 ALLOCATE (rho_g(nspins))
264 CALL qs_rho_set(rho, rho_g=rho_g)
265 DO i = 1, nspins
266 CALL auxbas_pw_pool%create_pw(rho_g(i))
267 END DO
268 END IF
269
270 ! SCCS
271 IF (dft_control%do_sccs) THEN
272 IF (my_rebuild_grids .OR. (.NOT. ASSOCIATED(rho_r_sccs))) THEN
273 IF (ASSOCIATED(rho_r_sccs)) THEN
274 CALL rho_r_sccs%release()
275 DEALLOCATE (rho_r_sccs)
276 END IF
277 ALLOCATE (rho_r_sccs)
278 CALL qs_rho_set(rho, rho_r_sccs=rho_r_sccs)
279 CALL auxbas_pw_pool%create_pw(rho_r_sccs)
280 CALL pw_zero(rho_r_sccs)
281 END IF
282 END IF
283
284 ! allocate drho_r and drho_g if xc_deriv_collocate
285 IF (dft_control%drho_by_collocation) THEN
286 ! drho_r
287 IF (my_rebuild_grids .OR. .NOT. ASSOCIATED(drho_r)) THEN
288 IF (ASSOCIATED(drho_r)) THEN
289 DO j = 1, SIZE(drho_r, 2)
290 DO i = 1, SIZE(drho_r, 1)
291 CALL drho_r(i, j)%release()
292 END DO
293 END DO
294 DEALLOCATE (drho_r)
295 END IF
296 ALLOCATE (drho_r(3, nspins))
297 CALL qs_rho_set(rho, drho_r=drho_r)
298 DO j = 1, nspins
299 DO i = 1, 3
300 CALL auxbas_pw_pool%create_pw(drho_r(i, j))
301 END DO
302 END DO
303 END IF
304 ! drho_g
305 IF (my_rebuild_grids .OR. .NOT. ASSOCIATED(drho_g)) THEN
306 IF (ASSOCIATED(drho_g)) THEN
307 DO j = 1, SIZE(drho_g, 2)
308 DO i = 1, SIZE(drho_r, 1)
309 CALL drho_g(i, j)%release()
310 END DO
311 END DO
312 DEALLOCATE (drho_g)
313 END IF
314 ALLOCATE (drho_g(3, nspins))
315 CALL qs_rho_set(rho, drho_g=drho_g)
316 DO j = 1, nspins
317 DO i = 1, 3
318 CALL auxbas_pw_pool%create_pw(drho_g(i, j))
319 END DO
320 END DO
321 END IF
322 END IF
323
324 ! allocate tau_r and tau_g if use_kinetic_energy_density
325 IF (dft_control%use_kinetic_energy_density) THEN
326 ! tau_r
327 IF (my_rebuild_grids .OR. .NOT. ASSOCIATED(tau_r)) THEN
328 IF (ASSOCIATED(tau_r)) THEN
329 DO i = 1, SIZE(tau_r)
330 CALL tau_r(i)%release()
331 END DO
332 DEALLOCATE (tau_r)
333 END IF
334 ALLOCATE (tau_r(nspins))
335 CALL qs_rho_set(rho, tau_r=tau_r)
336 DO i = 1, nspins
337 CALL auxbas_pw_pool%create_pw(tau_r(i))
338 END DO
339 END IF
340
341 ! tau_g
342 IF (my_rebuild_grids .OR. .NOT. ASSOCIATED(tau_g)) THEN
343 IF (ASSOCIATED(tau_g)) THEN
344 DO i = 1, SIZE(tau_g)
345 CALL tau_g(i)%release()
346 END DO
347 DEALLOCATE (tau_g)
348 END IF
349 ALLOCATE (tau_g(nspins))
350 CALL qs_rho_set(rho, tau_g=tau_g)
351 DO i = 1, nspins
352 CALL auxbas_pw_pool%create_pw(tau_g(i))
353 END DO
354 END IF
355 END IF ! use_kinetic_energy_density
356
357 CALL timestop(handle)
358
359 END SUBROUTINE qs_rho_rebuild
360
361! **************************************************************************************************
362!> \brief updates rho_r and rho_g to the rho%rho_ao.
363!> if use_kinetic_energy_density also computes tau_r and tau_g
364!> this works for all ground state and ground state response methods
365!> \param rho_struct the rho structure that should be updated
366!> \param qs_env the qs_env rho_struct refers to
367!> the integrated charge in r space
368!> \param rho_xc_external ...
369!> \param local_rho_set ...
370!> \param task_list_external external task list
371!> \param task_list_external_soft external task list (soft_version)
372!> \param pw_env_external external plane wave environment
373!> \param para_env_external external MPI environment
374!> \par History
375!> 08.2002 created [fawzi]
376!> \author Fawzi Mohamed
377! **************************************************************************************************
378 SUBROUTINE qs_rho_update_rho(rho_struct, qs_env, rho_xc_external, local_rho_set, &
379 task_list_external, task_list_external_soft, &
380 pw_env_external, para_env_external)
381 TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
382 TYPE(qs_environment_type), POINTER :: qs_env
383 TYPE(qs_rho_type), OPTIONAL, POINTER :: rho_xc_external
384 TYPE(local_rho_type), OPTIONAL, POINTER :: local_rho_set
385 TYPE(task_list_type), OPTIONAL, POINTER :: task_list_external, &
386 task_list_external_soft
387 TYPE(pw_env_type), OPTIONAL, POINTER :: pw_env_external
388 TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env_external
389
390 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
391 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
392 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao
393 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp
394 TYPE(dft_control_type), POINTER :: dft_control
395 TYPE(harris_type), POINTER :: harris_env
396 TYPE(kpoint_type), POINTER :: kpoints
397 TYPE(lri_density_type), POINTER :: lri_density
398 TYPE(lri_environment_type), POINTER :: lri_env
399 TYPE(mp_para_env_type), POINTER :: para_env
400 TYPE(qs_ks_env_type), POINTER :: ks_env
401
402 CALL get_qs_env(qs_env, dft_control=dft_control, &
403 atomic_kind_set=atomic_kind_set, &
404 para_env=para_env)
405 IF (PRESENT(para_env_external)) para_env => para_env_external
406
407 IF (qs_env%harris_method) THEN
408 CALL get_qs_env(qs_env, harris_env=harris_env)
409 CALL calculate_harris_density(qs_env, harris_env, rho_struct)
410 CALL qs_rho_set(rho_struct, rho_r_valid=.true., rho_g_valid=.true.)
411
412 ELSE IF (dft_control%qs_control%semi_empirical .OR. &
413 dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb) THEN
414
415 CALL qs_rho_set(rho_struct, rho_r_valid=.false., rho_g_valid=.false.)
416
417 ELSE IF (dft_control%qs_control%lrigpw) THEN
418 cpassert(.NOT. dft_control%use_kinetic_energy_density)
419 cpassert(.NOT. dft_control%drho_by_collocation)
420 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_kp)
421 CALL get_qs_env(qs_env, ks_env=ks_env)
422 CALL get_ks_env(ks_env=ks_env, kpoints=kpoints)
423 CALL get_kpoint_info(kpoint=kpoints, cell_to_index=cell_to_index)
424 CALL get_qs_env(qs_env, lri_env=lri_env, lri_density=lri_density)
425 CALL calculate_lri_densities(lri_env, lri_density, qs_env, rho_ao_kp, cell_to_index, &
426 lri_rho_struct=rho_struct, &
427 atomic_kind_set=atomic_kind_set, &
428 para_env=para_env, &
429 response_density=.false.)
430 CALL set_qs_env(qs_env, lri_density=lri_density)
431 CALL qs_rho_set(rho_struct, rho_r_valid=.true., rho_g_valid=.true.)
432
433 ELSE IF (dft_control%qs_control%rigpw) THEN
434 cpassert(.NOT. dft_control%use_kinetic_energy_density)
435 cpassert(.NOT. dft_control%drho_by_collocation)
436 CALL get_qs_env(qs_env, lri_env=lri_env)
437 CALL qs_rho_get(rho_struct, rho_ao=rho_ao)
438 CALL calculate_ri_densities(lri_env, qs_env, rho_ao, &
439 lri_rho_struct=rho_struct, &
440 atomic_kind_set=atomic_kind_set, &
441 para_env=para_env)
442 CALL qs_rho_set(rho_struct, rho_r_valid=.true., rho_g_valid=.true.)
443
444 ELSE
445 CALL qs_rho_update_rho_low(rho_struct=rho_struct, qs_env=qs_env, &
446 rho_xc_external=rho_xc_external, &
447 local_rho_set=local_rho_set, &
448 task_list_external=task_list_external, &
449 task_list_external_soft=task_list_external_soft, &
450 pw_env_external=pw_env_external, &
451 para_env_external=para_env_external)
452
453 END IF
454
455 END SUBROUTINE qs_rho_update_rho
456
457! **************************************************************************************************
458!> \brief updates rho_r and rho_g to the rho%rho_ao.
459!> if use_kinetic_energy_density also computes tau_r and tau_g
460!> \param rho_struct the rho structure that should be updated
461!> \param qs_env the qs_env rho_struct refers to
462!> the integrated charge in r space
463!> \param rho_xc_external rho structure for GAPW_XC
464!> \param local_rho_set ...
465!> \param pw_env_external external plane wave environment
466!> \param task_list_external external task list (use for default and GAPW)
467!> \param task_list_external_soft external task list (soft density for GAPW_XC)
468!> \param para_env_external ...
469!> \par History
470!> 08.2002 created [fawzi]
471!> \author Fawzi Mohamed
472! **************************************************************************************************
473 SUBROUTINE qs_rho_update_rho_low(rho_struct, qs_env, rho_xc_external, &
474 local_rho_set, pw_env_external, &
475 task_list_external, task_list_external_soft, &
476 para_env_external)
477 TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
478 TYPE(qs_environment_type), POINTER :: qs_env
479 TYPE(qs_rho_type), OPTIONAL, POINTER :: rho_xc_external
480 TYPE(local_rho_type), OPTIONAL, POINTER :: local_rho_set
481 TYPE(pw_env_type), OPTIONAL, POINTER :: pw_env_external
482 TYPE(task_list_type), OPTIONAL, POINTER :: task_list_external, &
483 task_list_external_soft
484 TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env_external
485
486 CHARACTER(len=*), PARAMETER :: routinen = 'qs_rho_update_rho_low'
487
488 INTEGER :: handle, img, ispin, nimg, nspins
489 LOGICAL :: gapw, gapw_xc
490 REAL(kind=dp) :: dum
491 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_r, tot_rho_r_xc
492 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
493 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao
494 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp, rho_xc_ao
495 TYPE(dft_control_type), POINTER :: dft_control
496 TYPE(mp_para_env_type), POINTER :: para_env
497 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
498 POINTER :: sab
499 TYPE(oce_matrix_type), POINTER :: oce
500 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g, rho_xc_g, tau_g, tau_xc_g
501 TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g, drho_xc_g
502 TYPE(pw_env_type), POINTER :: pw_env
503 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r, rho_xc_r, tau_r, tau_xc_r
504 TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r, drho_xc_r
505 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
506 TYPE(qs_ks_env_type), POINTER :: ks_env
507 TYPE(qs_rho_type), POINTER :: rho_xc
508 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
509 TYPE(task_list_type), POINTER :: task_list
510
511 CALL timeset(routinen, handle)
512
513 NULLIFY (dft_control, rho_xc, ks_env, rho_ao, rho_r, rho_g, drho_r, drho_g, tau_r, tau_g)
514 NULLIFY (rho_xc_ao, rho_xc_g, rho_xc_r, drho_xc_g, tau_xc_r, tau_xc_g, tot_rho_r, tot_rho_r_xc)
515 NULLIFY (para_env, pw_env, atomic_kind_set)
516
517 CALL get_qs_env(qs_env, &
518 ks_env=ks_env, &
519 dft_control=dft_control, &
520 atomic_kind_set=atomic_kind_set)
521
522 CALL qs_rho_get(rho_struct, &
523 rho_r=rho_r, &
524 rho_g=rho_g, &
525 tot_rho_r=tot_rho_r, &
526 drho_r=drho_r, &
527 drho_g=drho_g, &
528 tau_r=tau_r, &
529 tau_g=tau_g)
530
531 CALL get_qs_env(qs_env, task_list=task_list, &
532 para_env=para_env, pw_env=pw_env)
533 IF (PRESENT(pw_env_external)) pw_env => pw_env_external
534 IF (PRESENT(task_list_external)) task_list => task_list_external
535 IF (PRESENT(para_env_external)) para_env => para_env_external
536
537 nspins = dft_control%nspins
538 nimg = dft_control%nimages
539 gapw = dft_control%qs_control%gapw
540 gapw_xc = dft_control%qs_control%gapw_xc
541
542 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_kp)
543 DO ispin = 1, nspins
544 rho_ao => rho_ao_kp(ispin, :)
545 CALL calculate_rho_elec(matrix_p_kp=rho_ao, &
546 rho=rho_r(ispin), &
547 rho_gspace=rho_g(ispin), &
548 total_rho=tot_rho_r(ispin), &
549 ks_env=ks_env, soft_valid=gapw, &
550 task_list_external=task_list_external, &
551 pw_env_external=pw_env_external)
552 END DO
553 CALL qs_rho_set(rho_struct, rho_r_valid=.true., rho_g_valid=.true.)
554
555 IF (gapw_xc) THEN
556 IF (PRESENT(rho_xc_external)) THEN
557 rho_xc => rho_xc_external
558 ELSE
559 CALL get_qs_env(qs_env=qs_env, rho_xc=rho_xc)
560 END IF
561 CALL qs_rho_get(rho_xc, &
562 rho_ao_kp=rho_xc_ao, &
563 rho_r=rho_xc_r, &
564 rho_g=rho_xc_g, &
565 tot_rho_r=tot_rho_r_xc)
566 ! copy rho_ao into rho_xc_ao
567 DO ispin = 1, nspins
568 DO img = 1, nimg
569 CALL dbcsr_copy(rho_xc_ao(ispin, img)%matrix, rho_ao_kp(ispin, img)%matrix)
570 END DO
571 END DO
572 DO ispin = 1, nspins
573 rho_ao => rho_xc_ao(ispin, :)
574 CALL calculate_rho_elec(matrix_p_kp=rho_ao, &
575 rho=rho_xc_r(ispin), &
576 rho_gspace=rho_xc_g(ispin), &
577 total_rho=tot_rho_r_xc(ispin), &
578 ks_env=ks_env, soft_valid=gapw_xc, &
579 task_list_external=task_list_external_soft, &
580 pw_env_external=pw_env_external)
581 END DO
582 CALL qs_rho_set(rho_xc, rho_r_valid=.true., rho_g_valid=.true.)
583 END IF
584
585 ! GAPW o GAPW_XC require the calculation of hard and soft local densities
586 IF (gapw .OR. gapw_xc) THEN
587 CALL get_qs_env(qs_env=qs_env, &
588 rho_atom_set=rho_atom_set, &
589 qs_kind_set=qs_kind_set, &
590 oce=oce, sab_orb=sab)
591 IF (PRESENT(local_rho_set)) rho_atom_set => local_rho_set%rho_atom_set
592 cpassert(ASSOCIATED(rho_atom_set))
593 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_kp)
594 CALL calculate_rho_atom_coeff(qs_env, rho_ao_kp, rho_atom_set, qs_kind_set, oce, sab, para_env)
595 END IF
596
597 IF (.NOT. gapw_xc) THEN
598 ! if needed compute also the gradient of the density
599 IF (dft_control%drho_by_collocation) THEN
600 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_kp)
601 cpassert(.NOT. PRESENT(task_list_external))
602 DO ispin = 1, nspins
603 rho_ao => rho_ao_kp(ispin, :)
604 CALL calculate_drho_elec(matrix_p_kp=rho_ao, &
605 drho=drho_r(:, ispin), &
606 drho_gspace=drho_g(:, ispin), &
607 qs_env=qs_env, soft_valid=gapw)
608 END DO
609 CALL qs_rho_set(rho_struct, drho_r_valid=.true., drho_g_valid=.true.)
610 END IF
611 ! if needed compute also the kinetic energy density
612 IF (dft_control%use_kinetic_energy_density) THEN
613 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_kp)
614 DO ispin = 1, nspins
615 rho_ao => rho_ao_kp(ispin, :)
616 CALL calculate_rho_elec(matrix_p_kp=rho_ao, &
617 rho=tau_r(ispin), &
618 rho_gspace=tau_g(ispin), &
619 total_rho=dum, & ! presumably not meaningful
620 ks_env=ks_env, soft_valid=gapw, &
621 compute_tau=.true., &
622 task_list_external=task_list_external, &
623 pw_env_external=pw_env_external)
624 END DO
625 CALL qs_rho_set(rho_struct, tau_r_valid=.true., tau_g_valid=.true.)
626 END IF
627 ELSE
628 CALL qs_rho_get(rho_xc, &
629 drho_r=drho_xc_r, &
630 drho_g=drho_xc_g, &
631 tau_r=tau_xc_r, &
632 tau_g=tau_xc_g)
633 ! if needed compute also the gradient of the density
634 IF (dft_control%drho_by_collocation) THEN
635 cpassert(.NOT. PRESENT(task_list_external))
636 DO ispin = 1, nspins
637 rho_ao => rho_xc_ao(ispin, :)
638 CALL calculate_drho_elec(matrix_p_kp=rho_ao, &
639 drho=drho_xc_r(:, ispin), &
640 drho_gspace=drho_xc_g(:, ispin), &
641 qs_env=qs_env, soft_valid=gapw_xc)
642 END DO
643 CALL qs_rho_set(rho_xc, drho_r_valid=.true., drho_g_valid=.true.)
644 END IF
645 ! if needed compute also the kinetic energy density
646 IF (dft_control%use_kinetic_energy_density) THEN
647 DO ispin = 1, nspins
648 rho_ao => rho_xc_ao(ispin, :)
649 CALL calculate_rho_elec(matrix_p_kp=rho_ao, &
650 rho=tau_xc_r(ispin), &
651 rho_gspace=tau_xc_g(ispin), &
652 ks_env=ks_env, soft_valid=gapw_xc, &
653 compute_tau=.true., &
654 task_list_external=task_list_external_soft, &
655 pw_env_external=pw_env_external)
656 END DO
657 CALL qs_rho_set(rho_xc, tau_r_valid=.true., tau_g_valid=.true.)
658 END IF
659 END IF
660
661 CALL timestop(handle)
662
663 END SUBROUTINE qs_rho_update_rho_low
664
665! **************************************************************************************************
666!> \brief updates rho_r and rho_g to the rho%rho_ao.
667!> if use_kinetic_energy_density also computes tau_r and tau_g
668!> \param rho_struct the rho structure that should be updated
669!> \param qs_env the qs_env rho_struct refers to
670!> the integrated charge in r space
671!> \param pw_env_external external plane wave environment
672!> \param task_list_external external task list
673!> \param para_env_external ...
674!> \param tddfpt_lri_env ...
675!> \param tddfpt_lri_density ...
676!> \par History
677!> 08.2002 created [fawzi]
678!> \author Fawzi Mohamed
679! **************************************************************************************************
680 SUBROUTINE qs_rho_update_tddfpt(rho_struct, qs_env, pw_env_external, task_list_external, &
681 para_env_external, tddfpt_lri_env, tddfpt_lri_density)
682 TYPE(qs_rho_type), INTENT(INOUT) :: rho_struct
683 TYPE(qs_environment_type), POINTER :: qs_env
684 TYPE(pw_env_type), OPTIONAL, POINTER :: pw_env_external
685 TYPE(task_list_type), OPTIONAL, POINTER :: task_list_external
686 TYPE(mp_para_env_type), OPTIONAL, POINTER :: para_env_external
687 TYPE(lri_environment_type), OPTIONAL, POINTER :: tddfpt_lri_env
688 TYPE(lri_density_type), OPTIONAL, POINTER :: tddfpt_lri_density
689
690 CHARACTER(len=*), PARAMETER :: routinen = 'qs_rho_update_tddfpt'
691
692 INTEGER :: handle, ispin, nspins
693 INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index
694 LOGICAL :: lri_response
695 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_r
696 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
697 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao
698 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp
699 TYPE(dft_control_type), POINTER :: dft_control
700 TYPE(kpoint_type), POINTER :: kpoints
701 TYPE(mp_para_env_type), POINTER :: para_env
702 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g
703 TYPE(pw_env_type), POINTER :: pw_env
704 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
705 TYPE(qs_ks_env_type), POINTER :: ks_env
706 TYPE(task_list_type), POINTER :: task_list
707
708 CALL timeset(routinen, handle)
709
710 CALL get_qs_env(qs_env, &
711 ks_env=ks_env, &
712 dft_control=dft_control, &
713 atomic_kind_set=atomic_kind_set, &
714 task_list=task_list, &
715 para_env=para_env, &
716 pw_env=pw_env)
717 IF (PRESENT(pw_env_external)) pw_env => pw_env_external
718 IF (PRESENT(task_list_external)) task_list => task_list_external
719 IF (PRESENT(para_env_external)) para_env => para_env_external
720
721 CALL qs_rho_get(rho_struct, &
722 rho_r=rho_r, &
723 rho_g=rho_g, &
724 tot_rho_r=tot_rho_r)
725
726 nspins = dft_control%nspins
727
728 lri_response = PRESENT(tddfpt_lri_env)
729 IF (lri_response) THEN
730 cpassert(PRESENT(tddfpt_lri_density))
731 END IF
732
733 cpassert(.NOT. dft_control%drho_by_collocation)
734 cpassert(.NOT. dft_control%use_kinetic_energy_density)
735 cpassert(.NOT. dft_control%qs_control%gapw)
736 cpassert(.NOT. dft_control%qs_control%gapw_xc)
737
738 IF (lri_response) THEN
739 CALL get_ks_env(ks_env=ks_env, kpoints=kpoints)
740 CALL get_kpoint_info(kpoint=kpoints, cell_to_index=cell_to_index)
741 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_kp)
742 CALL calculate_lri_densities(tddfpt_lri_env, tddfpt_lri_density, qs_env, rho_ao_kp, cell_to_index, &
743 lri_rho_struct=rho_struct, &
744 atomic_kind_set=atomic_kind_set, &
745 para_env=para_env, &
746 response_density=lri_response)
747 CALL qs_rho_set(rho_struct, rho_r_valid=.true., rho_g_valid=.true.)
748 ELSE
749 CALL qs_rho_get(rho_struct, rho_ao_kp=rho_ao_kp)
750 DO ispin = 1, nspins
751 rho_ao => rho_ao_kp(ispin, :)
752 CALL calculate_rho_elec(matrix_p_kp=rho_ao, &
753 rho=rho_r(ispin), &
754 rho_gspace=rho_g(ispin), &
755 total_rho=tot_rho_r(ispin), &
756 ks_env=ks_env, &
757 task_list_external=task_list_external, &
758 pw_env_external=pw_env_external)
759 END DO
760 CALL qs_rho_set(rho_struct, rho_r_valid=.true., rho_g_valid=.true.)
761 END IF
762
763 CALL timestop(handle)
764
765 END SUBROUTINE qs_rho_update_tddfpt
766
767! **************************************************************************************************
768!> \brief Allocate a density structure and fill it with data from an input structure
769!> SIZE(rho_input) == mspin == 1 direct copy
770!> SIZE(rho_input) == mspin == 2 direct copy of alpha and beta spin
771!> SIZE(rho_input) == 1 AND mspin == 2 copy rho/2 into alpha and beta spin
772!> \param rho_input ...
773!> \param rho_output ...
774!> \param auxbas_pw_pool ...
775!> \param mspin ...
776!> \param factor ...
777! **************************************************************************************************
778 SUBROUTINE qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin, factor)
779
780 TYPE(qs_rho_type), INTENT(IN) :: rho_input
781 TYPE(qs_rho_type), INTENT(INOUT) :: rho_output
782 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
783 INTEGER, INTENT(IN) :: mspin
784 REAL(kind=dp), INTENT(IN), OPTIONAL :: factor
785
786 CHARACTER(len=*), PARAMETER :: routinen = 'qs_rho_copy'
787
788 INTEGER :: handle, i, j, nspins
789 LOGICAL :: complex_rho_ao, drho_g_valid_in, drho_r_valid_in, rho_g_valid_in, rho_r_valid_in, &
790 soft_valid_in, tau_g_valid_in, tau_r_valid_in
791 REAL(kind=dp) :: ospin
792 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_g_in, tot_rho_g_out, &
793 tot_rho_r_in, tot_rho_r_out
794 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im_in, rho_ao_im_out, rho_ao_in, &
795 rho_ao_out
796 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp_in
797 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g_in, rho_g_out, tau_g_in, tau_g_out
798 TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g_in, drho_g_out
799 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r_in, rho_r_out, tau_r_in, tau_r_out
800 TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r_in, drho_r_out
801 TYPE(pw_r3d_rs_type), POINTER :: rho_r_sccs_in, rho_r_sccs_out
802
803 CALL timeset(routinen, handle)
804
805 cpassert(mspin == 1 .OR. mspin == 2)
806 ospin = 1._dp/real(mspin, kind=dp)
807 IF (PRESENT(factor)) THEN
808 ospin = ospin*factor
809 END IF
810
811 CALL qs_rho_clear(rho_output)
812
813 NULLIFY (rho_ao_in, rho_ao_kp_in, rho_ao_im_in, rho_r_in, rho_g_in, drho_r_in, &
814 drho_g_in, tau_r_in, tau_g_in, tot_rho_r_in, tot_rho_g_in, rho_r_sccs_in)
815
816 CALL qs_rho_get(rho_input, &
817 rho_ao=rho_ao_in, &
818 rho_ao_kp=rho_ao_kp_in, &
819 rho_ao_im=rho_ao_im_in, &
820 rho_r=rho_r_in, &
821 rho_g=rho_g_in, &
822 drho_r=drho_r_in, &
823 drho_g=drho_g_in, &
824 tau_r=tau_r_in, &
825 tau_g=tau_g_in, &
826 tot_rho_r=tot_rho_r_in, &
827 tot_rho_g=tot_rho_g_in, &
828 rho_g_valid=rho_g_valid_in, &
829 rho_r_valid=rho_r_valid_in, &
830 drho_g_valid=drho_g_valid_in, &
831 drho_r_valid=drho_r_valid_in, &
832 tau_r_valid=tau_r_valid_in, &
833 tau_g_valid=tau_g_valid_in, &
834 rho_r_sccs=rho_r_sccs_in, &
835 soft_valid=soft_valid_in, &
836 complex_rho_ao=complex_rho_ao)
837
838 NULLIFY (rho_ao_out, rho_ao_im_out, rho_r_out, rho_g_out, drho_r_out, &
839 drho_g_out, tau_r_out, tau_g_out, tot_rho_r_out, tot_rho_g_out, rho_r_sccs_out)
840 ! rho_ao
841 IF (ASSOCIATED(rho_ao_in)) THEN
842 nspins = SIZE(rho_ao_in)
843 cpassert(mspin >= nspins)
844 CALL dbcsr_allocate_matrix_set(rho_ao_out, mspin)
845 CALL qs_rho_set(rho_output, rho_ao=rho_ao_out)
846 IF (mspin > nspins) THEN
847 DO i = 1, mspin
848 ALLOCATE (rho_ao_out(i)%matrix)
849 CALL dbcsr_copy(rho_ao_out(i)%matrix, rho_ao_in(1)%matrix, name="RHO copy")
850 CALL dbcsr_scale(rho_ao_out(i)%matrix, ospin)
851 END DO
852 ELSE
853 DO i = 1, nspins
854 ALLOCATE (rho_ao_out(i)%matrix)
855 CALL dbcsr_copy(rho_ao_out(i)%matrix, rho_ao_in(i)%matrix, name="RHO copy")
856 END DO
857 END IF
858 END IF
859
860 ! rho_ao_kp
861 ! only for non-kp, we could probably just copy this pointer, should work also for non-kp?
862 !IF (ASSOCIATED(rho_ao_kp_in)) THEN
863 ! CPABORT("Copy not available")
864 !END IF
865
866 ! rho_ao_im
867 IF (ASSOCIATED(rho_ao_im_in)) THEN
868 nspins = SIZE(rho_ao_im_in)
869 cpassert(mspin >= nspins)
870 CALL dbcsr_allocate_matrix_set(rho_ao_im_out, mspin)
871 CALL qs_rho_set(rho_output, rho_ao_im=rho_ao_im_out)
872 IF (mspin > nspins) THEN
873 DO i = 1, mspin
874 ALLOCATE (rho_ao_im_out(i)%matrix)
875 CALL dbcsr_copy(rho_ao_im_out(i)%matrix, rho_ao_im_in(1)%matrix, name="RHO copy")
876 CALL dbcsr_scale(rho_ao_im_out(i)%matrix, ospin)
877 END DO
878 ELSE
879 DO i = 1, nspins
880 ALLOCATE (rho_ao_im_out(i)%matrix)
881 CALL dbcsr_copy(rho_ao_im_out(i)%matrix, rho_ao_im_in(i)%matrix, name="RHO copy")
882 END DO
883 END IF
884 END IF
885
886 ! rho_r
887 IF (ASSOCIATED(rho_r_in)) THEN
888 nspins = SIZE(rho_r_in)
889 cpassert(mspin >= nspins)
890 ALLOCATE (rho_r_out(mspin))
891 CALL qs_rho_set(rho_output, rho_r=rho_r_out)
892 IF (mspin > nspins) THEN
893 DO i = 1, mspin
894 CALL auxbas_pw_pool%create_pw(rho_r_out(i))
895 CALL pw_copy(rho_r_in(1), rho_r_out(i))
896 CALL pw_scale(rho_r_out(i), ospin)
897 END DO
898 ELSE
899 DO i = 1, nspins
900 CALL auxbas_pw_pool%create_pw(rho_r_out(i))
901 CALL pw_copy(rho_r_in(i), rho_r_out(i))
902 END DO
903 END IF
904 END IF
905
906 ! rho_g
907 IF (ASSOCIATED(rho_g_in)) THEN
908 nspins = SIZE(rho_g_in)
909 cpassert(mspin >= nspins)
910 ALLOCATE (rho_g_out(mspin))
911 CALL qs_rho_set(rho_output, rho_g=rho_g_out)
912 IF (mspin > nspins) THEN
913 DO i = 1, mspin
914 CALL auxbas_pw_pool%create_pw(rho_g_out(i))
915 CALL pw_copy(rho_g_in(1), rho_g_out(i))
916 CALL pw_scale(rho_g_out(i), ospin)
917 END DO
918 ELSE
919 DO i = 1, nspins
920 CALL auxbas_pw_pool%create_pw(rho_g_out(i))
921 CALL pw_copy(rho_g_in(i), rho_g_out(i))
922 END DO
923 END IF
924 END IF
925
926 ! SCCS
927 IF (ASSOCIATED(rho_r_sccs_in)) THEN
928 CALL qs_rho_set(rho_output, rho_r_sccs=rho_r_sccs_out)
929 CALL auxbas_pw_pool%create_pw(rho_r_sccs_out)
930 CALL pw_copy(rho_r_sccs_in, rho_r_sccs_out)
931 END IF
932
933 ! drho_r
934 IF (ASSOCIATED(drho_r_in)) THEN
935 nspins = SIZE(drho_r_in)
936 cpassert(mspin >= nspins)
937 ALLOCATE (drho_r_out(3, mspin))
938 CALL qs_rho_set(rho_output, drho_r=drho_r_out)
939 IF (mspin > nspins) THEN
940 DO j = 1, mspin
941 DO i = 1, 3
942 CALL auxbas_pw_pool%create_pw(drho_r_out(i, j))
943 CALL pw_copy(drho_r_in(i, 1), drho_r_out(i, j))
944 CALL pw_scale(drho_r_out(i, j), ospin)
945 END DO
946 END DO
947 ELSE
948 DO j = 1, nspins
949 DO i = 1, 3
950 CALL auxbas_pw_pool%create_pw(drho_r_out(i, j))
951 CALL pw_copy(drho_r_in(i, j), drho_r_out(i, j))
952 END DO
953 END DO
954 END IF
955 END IF
956
957 ! drho_g
958 IF (ASSOCIATED(drho_g_in)) THEN
959 nspins = SIZE(drho_g_in)
960 cpassert(mspin >= nspins)
961 ALLOCATE (drho_g_out(3, mspin))
962 CALL qs_rho_set(rho_output, drho_g=drho_g_out)
963 IF (mspin > nspins) THEN
964 DO j = 1, mspin
965 DO i = 1, 3
966 CALL auxbas_pw_pool%create_pw(drho_g_out(i, j))
967 CALL pw_copy(drho_g_in(i, 1), drho_g_out(i, j))
968 CALL pw_scale(drho_g_out(i, j), ospin)
969 END DO
970 END DO
971 ELSE
972 DO j = 1, nspins
973 DO i = 1, 3
974 CALL auxbas_pw_pool%create_pw(drho_g_out(i, j))
975 CALL pw_copy(drho_g_in(i, j), drho_g_out(i, j))
976 END DO
977 END DO
978 END IF
979 END IF
980
981 ! tau_r
982 IF (ASSOCIATED(tau_r_in)) THEN
983 nspins = SIZE(tau_r_in)
984 cpassert(mspin >= nspins)
985 ALLOCATE (tau_r_out(mspin))
986 CALL qs_rho_set(rho_output, tau_r=tau_r_out)
987 IF (mspin > nspins) THEN
988 DO i = 1, mspin
989 CALL auxbas_pw_pool%create_pw(tau_r_out(i))
990 CALL pw_copy(tau_r_in(1), tau_r_out(i))
991 CALL pw_scale(tau_r_out(i), ospin)
992 END DO
993 ELSE
994 DO i = 1, nspins
995 CALL auxbas_pw_pool%create_pw(tau_r_out(i))
996 CALL pw_copy(tau_r_in(i), tau_r_out(i))
997 END DO
998 END IF
999 END IF
1000
1001 ! tau_g
1002 IF (ASSOCIATED(tau_g_in)) THEN
1003 nspins = SIZE(tau_g_in)
1004 cpassert(mspin >= nspins)
1005 ALLOCATE (tau_g_out(mspin))
1006 CALL qs_rho_set(rho_output, tau_g=tau_g_out)
1007 IF (mspin > nspins) THEN
1008 DO i = 1, mspin
1009 CALL auxbas_pw_pool%create_pw(tau_g_out(i))
1010 CALL pw_copy(tau_g_in(1), tau_g_out(i))
1011 CALL pw_scale(tau_g_out(i), ospin)
1012 END DO
1013 ELSE
1014 DO i = 1, nspins
1015 CALL auxbas_pw_pool%create_pw(tau_g_out(i))
1016 CALL pw_copy(tau_g_in(i), tau_g_out(i))
1017 END DO
1018 END IF
1019 END IF
1020
1021 ! tot_rho_r
1022 IF (ASSOCIATED(tot_rho_r_in)) THEN
1023 nspins = SIZE(tot_rho_r_in)
1024 cpassert(mspin >= nspins)
1025 ALLOCATE (tot_rho_r_out(mspin))
1026 CALL qs_rho_set(rho_output, tot_rho_r=tot_rho_r_out)
1027 IF (mspin > nspins) THEN
1028 DO i = 1, mspin
1029 tot_rho_r_out(i) = tot_rho_r_in(1)*ospin
1030 END DO
1031 ELSE
1032 DO i = 1, nspins
1033 tot_rho_r_out(i) = tot_rho_r_in(i)
1034 END DO
1035 END IF
1036 END IF
1037
1038 ! tot_rho_g
1039 IF (ASSOCIATED(tot_rho_g_in)) THEN
1040 nspins = SIZE(tot_rho_g_in)
1041 cpassert(mspin >= nspins)
1042 ALLOCATE (tot_rho_g_out(mspin))
1043 CALL qs_rho_set(rho_output, tot_rho_g=tot_rho_g_out)
1044 IF (mspin > nspins) THEN
1045 DO i = 1, mspin
1046 tot_rho_g_out(i) = tot_rho_g_in(1)*ospin
1047 END DO
1048 ELSE
1049 DO i = 1, nspins
1050 tot_rho_g_out(i) = tot_rho_g_in(i)
1051 END DO
1052 END IF
1053 END IF
1054
1055 CALL qs_rho_set(rho_output, &
1056 rho_g_valid=rho_g_valid_in, &
1057 rho_r_valid=rho_r_valid_in, &
1058 drho_g_valid=drho_g_valid_in, &
1059 drho_r_valid=drho_r_valid_in, &
1060 tau_r_valid=tau_r_valid_in, &
1061 tau_g_valid=tau_g_valid_in, &
1062 soft_valid=soft_valid_in, &
1063 complex_rho_ao=complex_rho_ao)
1064
1065 CALL timestop(handle)
1066
1067 END SUBROUTINE qs_rho_copy
1068
1069! **************************************************************************************************
1070!> \brief Allocate a density structure and fill it with data from an input structure
1071!> Transfer all data to input pw_pool
1072!> \param rho_input ...
1073!> \param rho_output ...
1074!> \param in_pw_pool ...
1075!> \param out_pw_pool ...
1076! **************************************************************************************************
1077 SUBROUTINE qs_rho_transfer(rho_input, rho_output, in_pw_pool, out_pw_pool)
1078
1079 TYPE(qs_rho_type), INTENT(IN) :: rho_input
1080 TYPE(qs_rho_type), INTENT(INOUT) :: rho_output
1081 TYPE(pw_pool_type), POINTER :: in_pw_pool, out_pw_pool
1082
1083 CHARACTER(len=*), PARAMETER :: routinen = 'qs_rho_transfer'
1084
1085 INTEGER :: handle, i, j, nspins
1086 LOGICAL :: complex_rho_ao, drho_g_valid_in, drho_r_valid_in, rho_g_valid_in, rho_r_valid_in, &
1087 soft_valid_in, tau_g_valid_in, tau_r_valid_in
1088 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_g_in, tot_rho_g_out, &
1089 tot_rho_r_in, tot_rho_r_out
1090 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im_in, rho_ao_im_out, rho_ao_in, &
1091 rho_ao_out
1092 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp_in
1093 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g_in, rho_g_out, tau_g_in, tau_g_out
1094 TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g_in, drho_g_out
1095 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r_in, rho_r_out, tau_r_in, tau_r_out
1096 TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r_in, drho_r_out
1097 TYPE(pw_r3d_rs_type), POINTER :: rho_r_sccs_in, rho_r_sccs_out
1098
1099 CALL timeset(routinen, handle)
1100
1101 CALL qs_rho_clear(rho_output)
1102
1103 NULLIFY (rho_ao_in, rho_ao_kp_in, rho_ao_im_in, rho_r_in, rho_g_in, drho_r_in, &
1104 drho_g_in, tau_r_in, tau_g_in, tot_rho_r_in, tot_rho_g_in, rho_r_sccs_in)
1105
1106 CALL qs_rho_get(rho_input, &
1107 rho_ao=rho_ao_in, &
1108 rho_ao_kp=rho_ao_kp_in, &
1109 rho_ao_im=rho_ao_im_in, &
1110 rho_r=rho_r_in, &
1111 rho_g=rho_g_in, &
1112 drho_r=drho_r_in, &
1113 drho_g=drho_g_in, &
1114 tau_r=tau_r_in, &
1115 tau_g=tau_g_in, &
1116 tot_rho_r=tot_rho_r_in, &
1117 tot_rho_g=tot_rho_g_in, &
1118 rho_g_valid=rho_g_valid_in, &
1119 rho_r_valid=rho_r_valid_in, &
1120 drho_g_valid=drho_g_valid_in, &
1121 drho_r_valid=drho_r_valid_in, &
1122 tau_r_valid=tau_r_valid_in, &
1123 tau_g_valid=tau_g_valid_in, &
1124 rho_r_sccs=rho_r_sccs_in, &
1125 soft_valid=soft_valid_in, &
1126 complex_rho_ao=complex_rho_ao)
1127
1128 NULLIFY (rho_ao_out, rho_ao_im_out, rho_r_out, rho_g_out, drho_r_out, &
1129 drho_g_out, tau_r_out, tau_g_out, tot_rho_r_out, tot_rho_g_out, rho_r_sccs_out)
1130 ! rho_ao
1131 IF (ASSOCIATED(rho_ao_in)) THEN
1132 nspins = SIZE(rho_ao_in)
1133 CALL dbcsr_allocate_matrix_set(rho_ao_out, nspins)
1134 CALL qs_rho_set(rho_output, rho_ao=rho_ao_out)
1135 DO i = 1, nspins
1136 ALLOCATE (rho_ao_out(i)%matrix)
1137 CALL dbcsr_copy(rho_ao_out(i)%matrix, rho_ao_in(i)%matrix, name="RHO copy")
1138 END DO
1139 END IF
1140
1141 ! rho_ao_kp
1142 ! only for non-kp, we could probably just copy this pointer, should work also for non-kp?
1143 !IF (ASSOCIATED(rho_ao_kp_in)) THEN
1144 ! CPABORT("Copy not available")
1145 !END IF
1146
1147 ! rho_ao_im
1148 IF (ASSOCIATED(rho_ao_im_in)) THEN
1149 nspins = SIZE(rho_ao_im_in)
1150 CALL dbcsr_allocate_matrix_set(rho_ao_im_out, nspins)
1151 CALL qs_rho_set(rho_output, rho_ao_im=rho_ao_im_out)
1152 DO i = 1, nspins
1153 ALLOCATE (rho_ao_im_out(i)%matrix)
1154 CALL dbcsr_copy(rho_ao_im_out(i)%matrix, rho_ao_im_in(i)%matrix, name="RHO copy")
1155 END DO
1156 END IF
1157
1158 ! rho_r and rho_g
1159 IF (ASSOCIATED(rho_g_in)) THEN
1160 nspins = SIZE(rho_g_in)
1161 ALLOCATE (rho_g_out(nspins))
1162 CALL qs_rho_set(rho_output, rho_g=rho_g_out)
1163 IF (ASSOCIATED(rho_r_in)) THEN
1164 ALLOCATE (rho_r_out(nspins))
1165 CALL qs_rho_set(rho_output, rho_r=rho_r_out)
1166 END IF
1167 DO i = 1, nspins
1168 CALL out_pw_pool%create_pw(rho_g_out(i))
1169 CALL pw_transfer(rho_g_in(i), rho_g_out(i))
1170 IF (ASSOCIATED(rho_r_in)) THEN
1171 CALL out_pw_pool%create_pw(rho_r_out(i))
1172 CALL pw_transfer(rho_g_out(i), rho_r_out(i))
1173 END IF
1174 END DO
1175 ELSE IF (ASSOCIATED(rho_r_in)) THEN
1176 nspins = SIZE(rho_r_in)
1177 ALLOCATE (rho_r_out(nspins))
1178 CALL qs_rho_set(rho_output, rho_r=rho_r_out)
1179 DO i = 1, nspins
1180 CALL out_pw_pool%create_pw(rho_r_out(i))
1181 block
1182 TYPE(pw_c1d_gs_type) :: grho_in, grho_out
1183 CALL in_pw_pool%create_pw(grho_in)
1184 CALL out_pw_pool%create_pw(grho_out)
1185 CALL pw_transfer(rho_r_in(i), grho_in)
1186 CALL pw_transfer(grho_in, grho_out)
1187 CALL pw_transfer(grho_out, rho_r_out(i))
1188 CALL out_pw_pool%give_back_pw(grho_out)
1189 CALL in_pw_pool%give_back_pw(grho_in)
1190 END block
1191 END DO
1192 END IF
1193
1194 ! SCCS
1195 IF (ASSOCIATED(rho_r_sccs_in)) THEN
1196 CALL qs_rho_set(rho_output, rho_r_sccs=rho_r_sccs_out)
1197 CALL out_pw_pool%create_pw(rho_r_sccs_out)
1198 block
1199 TYPE(pw_c1d_gs_type) :: grho_in, grho_out
1200 CALL in_pw_pool%create_pw(grho_in)
1201 CALL out_pw_pool%create_pw(grho_out)
1202 CALL pw_transfer(rho_r_sccs_in, grho_in)
1203 CALL pw_transfer(grho_in, grho_out)
1204 CALL pw_transfer(grho_out, rho_r_sccs_out)
1205 CALL out_pw_pool%give_back_pw(grho_out)
1206 CALL in_pw_pool%give_back_pw(grho_in)
1207 END block
1208 END IF
1209
1210 ! drho_r and drho_g
1211 IF (ASSOCIATED(drho_g_in)) THEN
1212 nspins = SIZE(drho_g_in)
1213 ALLOCATE (drho_g_out(3, nspins))
1214 CALL qs_rho_set(rho_output, drho_g=drho_g_out)
1215 IF (ASSOCIATED(drho_r_in)) THEN
1216 ALLOCATE (drho_r_out(3, nspins))
1217 CALL qs_rho_set(rho_output, drho_r=drho_r_out)
1218 END IF
1219 DO i = 1, nspins
1220 DO j = 1, 3
1221 CALL out_pw_pool%create_pw(drho_g_out(j, i))
1222 CALL pw_transfer(drho_g_in(j, i), drho_g_out(j, i))
1223 IF (ASSOCIATED(drho_r_in)) THEN
1224 CALL out_pw_pool%create_pw(drho_r_out(j, i))
1225 CALL pw_transfer(drho_g_out(j, i), drho_r_out(j, i))
1226 END IF
1227 END DO
1228 END DO
1229 ELSE IF (ASSOCIATED(drho_r_in)) THEN
1230 nspins = SIZE(drho_r_in)
1231 ALLOCATE (drho_r_out(3, nspins))
1232 CALL qs_rho_set(rho_output, drho_r=drho_r_out)
1233 DO i = 1, nspins
1234 block
1235 TYPE(pw_c1d_gs_type) :: grho_in, grho_out
1236 CALL in_pw_pool%create_pw(grho_in)
1237 CALL out_pw_pool%create_pw(grho_out)
1238 DO j = 1, 3
1239 CALL out_pw_pool%create_pw(drho_r_out(j, i))
1240 CALL pw_transfer(drho_r_in(j, i), grho_in)
1241 CALL pw_transfer(grho_in, grho_out)
1242 CALL pw_transfer(grho_out, drho_r_out(j, i))
1243 END DO
1244 CALL out_pw_pool%give_back_pw(grho_out)
1245 CALL in_pw_pool%give_back_pw(grho_in)
1246 END block
1247 END DO
1248 END IF
1249
1250 ! tau_r and tau_g
1251 IF (ASSOCIATED(tau_g_in)) THEN
1252 nspins = SIZE(tau_g_in)
1253 ALLOCATE (tau_g_out(nspins))
1254 CALL qs_rho_set(rho_output, tau_g=tau_g_out)
1255 IF (ASSOCIATED(tau_r_in)) THEN
1256 ALLOCATE (tau_r_out(nspins))
1257 CALL qs_rho_set(rho_output, tau_r=tau_r_out)
1258 END IF
1259 DO i = 1, nspins
1260 CALL out_pw_pool%create_pw(tau_g_out(i))
1261 CALL pw_transfer(tau_g_in(i), tau_g_out(i))
1262 IF (ASSOCIATED(tau_r_in)) THEN
1263 CALL out_pw_pool%create_pw(tau_r_out(i))
1264 CALL pw_transfer(tau_g_out(i), tau_r_out(i))
1265 END IF
1266 END DO
1267 ELSE IF (ASSOCIATED(tau_r_in)) THEN
1268 nspins = SIZE(tau_r_in)
1269 ALLOCATE (tau_r_out(nspins))
1270 CALL qs_rho_set(rho_output, tau_r=tau_r_out)
1271 DO i = 1, nspins
1272 CALL out_pw_pool%create_pw(tau_r_out(i))
1273 block
1274 TYPE(pw_c1d_gs_type) :: gtau_in, gtau_out
1275 CALL in_pw_pool%create_pw(gtau_in)
1276 CALL out_pw_pool%create_pw(gtau_out)
1277 CALL pw_transfer(tau_r_in(i), gtau_in)
1278 CALL pw_transfer(gtau_in, gtau_out)
1279 CALL pw_transfer(gtau_out, tau_r_out(i))
1280 CALL out_pw_pool%give_back_pw(gtau_out)
1281 CALL in_pw_pool%give_back_pw(gtau_in)
1282 END block
1283 END DO
1284 END IF
1285
1286 ! tot_rho_r
1287 IF (ASSOCIATED(tot_rho_r_in)) THEN
1288 nspins = SIZE(tot_rho_r_in)
1289 ALLOCATE (tot_rho_r_out(nspins))
1290 CALL qs_rho_set(rho_output, tot_rho_r=tot_rho_r_out)
1291 DO i = 1, nspins
1292 tot_rho_r_out(i) = tot_rho_r_in(i)
1293 END DO
1294 END IF
1295
1296 ! tot_rho_g
1297 IF (ASSOCIATED(tot_rho_g_in)) THEN
1298 nspins = SIZE(tot_rho_g_in)
1299 ALLOCATE (tot_rho_g_out(nspins))
1300 CALL qs_rho_set(rho_output, tot_rho_g=tot_rho_g_out)
1301 DO i = 1, nspins
1302 tot_rho_g_out(i) = tot_rho_g_in(i)
1303 END DO
1304 END IF
1305
1306 CALL qs_rho_set(rho_output, &
1307 rho_g_valid=rho_g_valid_in, &
1308 rho_r_valid=rho_r_valid_in, &
1309 drho_g_valid=drho_g_valid_in, &
1310 drho_r_valid=drho_r_valid_in, &
1311 tau_r_valid=tau_r_valid_in, &
1312 tau_g_valid=tau_g_valid_in, &
1313 soft_valid=soft_valid_in, &
1314 complex_rho_ao=complex_rho_ao)
1315
1316 CALL timestop(handle)
1317
1318 END SUBROUTINE qs_rho_transfer
1319
1320! **************************************************************************************************
1321!> \brief rhoa(2) = alpha*rhoa(2)+beta*rhob(1)
1322!> \param rhoa ...
1323!> \param rhob ...
1324!> \param alpha ...
1325!> \param beta ...
1326! **************************************************************************************************
1327 SUBROUTINE qs_rho_scale_and_add_b(rhoa, rhob, alpha, beta)
1328
1329 TYPE(qs_rho_type), INTENT(IN) :: rhoa, rhob
1330 REAL(kind=dp), INTENT(IN) :: alpha, beta
1331
1332 CHARACTER(len=*), PARAMETER :: routinen = 'qs_rho_scale_and_add_b'
1333
1334 INTEGER :: handle
1335 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_g_a, tot_rho_g_b, tot_rho_r_a, &
1336 tot_rho_r_b
1337 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_a, rho_ao_b, rho_ao_im_a, &
1338 rho_ao_im_b
1339 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g_a, rho_g_b, tau_g_a, tau_g_b
1340 TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g_a, drho_g_b
1341 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r_a, rho_r_b, tau_r_a, tau_r_b
1342 TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r_a, drho_r_b
1343 TYPE(pw_r3d_rs_type), POINTER :: rho_r_sccs_a, rho_r_sccs_b
1344
1345 CALL timeset(routinen, handle)
1346
1347 NULLIFY (rho_ao_a, rho_ao_im_a, rho_r_a, rho_g_a, drho_r_a, &
1348 drho_g_a, tau_r_a, tau_g_a, tot_rho_r_a, tot_rho_g_a, rho_r_sccs_a)
1349
1350 CALL qs_rho_get(rhoa, &
1351 rho_ao=rho_ao_a, &
1352 rho_ao_im=rho_ao_im_a, &
1353 rho_r=rho_r_a, &
1354 rho_g=rho_g_a, &
1355 drho_r=drho_r_a, &
1356 drho_g=drho_g_a, &
1357 tau_r=tau_r_a, &
1358 tau_g=tau_g_a, &
1359 tot_rho_r=tot_rho_r_a, &
1360 tot_rho_g=tot_rho_g_a, &
1361 rho_r_sccs=rho_r_sccs_a)
1362
1363 NULLIFY (rho_ao_b, rho_ao_im_b, rho_r_b, rho_g_b, drho_r_b, &
1364 drho_g_b, tau_r_b, tau_g_b, tot_rho_r_b, tot_rho_g_b, rho_r_sccs_b)
1365
1366 CALL qs_rho_get(rhob, &
1367 rho_ao=rho_ao_b, &
1368 rho_ao_im=rho_ao_im_b, &
1369 rho_r=rho_r_b, &
1370 rho_g=rho_g_b, &
1371 drho_r=drho_r_b, &
1372 drho_g=drho_g_b, &
1373 tau_r=tau_r_b, &
1374 tau_g=tau_g_b, &
1375 tot_rho_r=tot_rho_r_b, &
1376 tot_rho_g=tot_rho_g_b, &
1377 rho_r_sccs=rho_r_sccs_b)
1378 ! rho_ao
1379 IF (ASSOCIATED(rho_ao_a) .AND. ASSOCIATED(rho_ao_b)) THEN
1380 CALL dbcsr_add(rho_ao_a(2)%matrix, rho_ao_b(1)%matrix, alpha, beta)
1381 END IF
1382
1383 ! rho_ao_im
1384 IF (ASSOCIATED(rho_ao_im_a) .AND. ASSOCIATED(rho_ao_im_b)) THEN
1385 CALL dbcsr_add(rho_ao_im_a(2)%matrix, rho_ao_im_b(1)%matrix, alpha, beta)
1386 END IF
1387
1388 ! rho_r
1389 IF (ASSOCIATED(rho_r_a) .AND. ASSOCIATED(rho_r_b)) THEN
1390 CALL pw_axpy(rho_r_b(1), rho_r_a(2), beta, alpha)
1391 END IF
1392
1393 ! rho_g
1394 IF (ASSOCIATED(rho_g_a) .AND. ASSOCIATED(rho_g_b)) THEN
1395 CALL pw_axpy(rho_g_b(1), rho_g_a(2), beta, alpha)
1396 END IF
1397
1398 ! SCCS
1399 IF (ASSOCIATED(rho_r_sccs_a) .AND. ASSOCIATED(rho_r_sccs_b)) THEN
1400 CALL pw_axpy(rho_r_sccs_b, rho_r_sccs_a, beta, alpha)
1401 END IF
1402
1403 ! drho_r
1404 IF (ASSOCIATED(drho_r_a) .AND. ASSOCIATED(drho_r_b)) THEN
1405 cpassert(ASSOCIATED(drho_r_a) .AND. ASSOCIATED(drho_r_b)) ! not implemented
1406 END IF
1407
1408 ! drho_g
1409 IF (ASSOCIATED(drho_g_a) .AND. ASSOCIATED(drho_g_b)) THEN
1410 cpassert(ASSOCIATED(drho_g_a) .AND. ASSOCIATED(drho_g_b)) ! not implemented
1411 END IF
1412
1413 ! tau_r
1414 IF (ASSOCIATED(tau_r_a) .AND. ASSOCIATED(tau_r_b)) THEN
1415 CALL pw_axpy(tau_r_b(1), tau_r_a(2), beta, alpha)
1416 END IF
1417
1418 ! tau_g
1419 IF (ASSOCIATED(tau_g_a) .AND. ASSOCIATED(tau_g_b)) THEN
1420 CALL pw_axpy(tau_g_b(1), tau_g_a(2), beta, alpha)
1421 END IF
1422
1423 ! tot_rho_r
1424 IF (ASSOCIATED(tot_rho_r_a) .AND. ASSOCIATED(tot_rho_r_b)) THEN
1425 tot_rho_r_a(2) = alpha*tot_rho_r_a(2) + beta*tot_rho_r_b(1)
1426 END IF
1427
1428 ! tot_rho_g
1429 IF (ASSOCIATED(tot_rho_g_a) .AND. ASSOCIATED(tot_rho_g_b)) THEN
1430 tot_rho_g_a(2) = alpha*tot_rho_g_a(2) + beta*tot_rho_g_b(1)
1431 END IF
1432
1433 CALL timestop(handle)
1434
1435 END SUBROUTINE qs_rho_scale_and_add_b
1436
1437! **************************************************************************************************
1438!> \brief rhoa = alpha*rhoa+beta*rhob
1439!> \param rhoa ...
1440!> \param rhob ...
1441!> \param alpha ...
1442!> \param beta ...
1443! **************************************************************************************************
1444 SUBROUTINE qs_rho_scale_and_add(rhoa, rhob, alpha, beta)
1445
1446 TYPE(qs_rho_type), INTENT(IN) :: rhoa, rhob
1447 REAL(kind=dp), INTENT(IN) :: alpha, beta
1448
1449 CHARACTER(len=*), PARAMETER :: routinen = 'qs_rho_scale_and_add'
1450
1451 INTEGER :: handle, i, j, nspina, nspinb, nspins
1452 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_g_a, tot_rho_g_b, tot_rho_r_a, &
1453 tot_rho_r_b
1454 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_a, rho_ao_b, rho_ao_im_a, &
1455 rho_ao_im_b
1456 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g_a, rho_g_b, tau_g_a, tau_g_b
1457 TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g_a, drho_g_b
1458 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r_a, rho_r_b, tau_r_a, tau_r_b
1459 TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r_a, drho_r_b
1460 TYPE(pw_r3d_rs_type), POINTER :: rho_r_sccs_a, rho_r_sccs_b
1461
1462 CALL timeset(routinen, handle)
1463
1464 NULLIFY (rho_ao_a, rho_ao_im_a, rho_r_a, rho_g_a, drho_r_a, &
1465 drho_g_a, tau_r_a, tau_g_a, tot_rho_r_a, tot_rho_g_a, rho_r_sccs_a)
1466
1467 CALL qs_rho_get(rhoa, &
1468 rho_ao=rho_ao_a, &
1469 rho_ao_im=rho_ao_im_a, &
1470 rho_r=rho_r_a, &
1471 rho_g=rho_g_a, &
1472 drho_r=drho_r_a, &
1473 drho_g=drho_g_a, &
1474 tau_r=tau_r_a, &
1475 tau_g=tau_g_a, &
1476 tot_rho_r=tot_rho_r_a, &
1477 tot_rho_g=tot_rho_g_a, &
1478 rho_r_sccs=rho_r_sccs_a)
1479
1480 NULLIFY (rho_ao_b, rho_ao_im_b, rho_r_b, rho_g_b, drho_r_b, &
1481 drho_g_b, tau_r_b, tau_g_b, tot_rho_r_b, tot_rho_g_b, rho_r_sccs_b)
1482
1483 CALL qs_rho_get(rhob, &
1484 rho_ao=rho_ao_b, &
1485 rho_ao_im=rho_ao_im_b, &
1486 rho_r=rho_r_b, &
1487 rho_g=rho_g_b, &
1488 drho_r=drho_r_b, &
1489 drho_g=drho_g_b, &
1490 tau_r=tau_r_b, &
1491 tau_g=tau_g_b, &
1492 tot_rho_r=tot_rho_r_b, &
1493 tot_rho_g=tot_rho_g_b, &
1494 rho_r_sccs=rho_r_sccs_b)
1495 ! rho_ao
1496 IF (ASSOCIATED(rho_ao_a) .AND. ASSOCIATED(rho_ao_b)) THEN
1497 nspina = SIZE(rho_ao_a)
1498 nspinb = SIZE(rho_ao_b)
1499 nspins = min(nspina, nspinb)
1500 DO i = 1, nspins
1501 CALL dbcsr_add(rho_ao_a(i)%matrix, rho_ao_b(i)%matrix, alpha, beta)
1502 END DO
1503 END IF
1504
1505 ! rho_ao_im
1506 IF (ASSOCIATED(rho_ao_im_a) .AND. ASSOCIATED(rho_ao_im_b)) THEN
1507 nspina = SIZE(rho_ao_im_a)
1508 nspinb = SIZE(rho_ao_im_b)
1509 nspins = min(nspina, nspinb)
1510 DO i = 1, nspins
1511 CALL dbcsr_add(rho_ao_im_a(i)%matrix, rho_ao_im_b(i)%matrix, alpha, beta)
1512 END DO
1513 END IF
1514
1515 ! rho_r
1516 IF (ASSOCIATED(rho_r_a) .AND. ASSOCIATED(rho_r_b)) THEN
1517 nspina = SIZE(rho_ao_a)
1518 nspinb = SIZE(rho_ao_b)
1519 nspins = min(nspina, nspinb)
1520 DO i = 1, nspins
1521 CALL pw_axpy(rho_r_b(i), rho_r_a(i), beta, alpha)
1522 END DO
1523 END IF
1524
1525 ! rho_g
1526 IF (ASSOCIATED(rho_g_a) .AND. ASSOCIATED(rho_g_b)) THEN
1527 nspina = SIZE(rho_ao_a)
1528 nspinb = SIZE(rho_ao_b)
1529 nspins = min(nspina, nspinb)
1530 DO i = 1, nspins
1531 CALL pw_axpy(rho_g_b(i), rho_g_a(i), beta, alpha)
1532 END DO
1533 END IF
1534
1535 ! SCCS
1536 IF (ASSOCIATED(rho_r_sccs_a) .AND. ASSOCIATED(rho_r_sccs_b)) THEN
1537 CALL pw_axpy(rho_r_sccs_b, rho_r_sccs_a, beta, alpha)
1538 END IF
1539
1540 ! drho_r
1541 IF (ASSOCIATED(drho_r_a) .AND. ASSOCIATED(drho_r_b)) THEN
1542 cpassert(all(shape(drho_r_a) == shape(drho_r_b))) ! not implemented
1543 DO j = 1, SIZE(drho_r_a, 2)
1544 DO i = 1, SIZE(drho_r_a, 1)
1545 CALL pw_axpy(drho_r_b(i, j), drho_r_a(i, j), beta, alpha)
1546 END DO
1547 END DO
1548 END IF
1549
1550 ! drho_g
1551 IF (ASSOCIATED(drho_g_a) .AND. ASSOCIATED(drho_g_b)) THEN
1552 cpassert(all(shape(drho_g_a) == shape(drho_g_b))) ! not implemented
1553 DO j = 1, SIZE(drho_g_a, 2)
1554 DO i = 1, SIZE(drho_g_a, 1)
1555 CALL pw_axpy(drho_g_b(i, j), drho_g_a(i, j), beta, alpha)
1556 END DO
1557 END DO
1558 END IF
1559
1560 ! tau_r
1561 IF (ASSOCIATED(tau_r_a) .AND. ASSOCIATED(tau_r_b)) THEN
1562 nspina = SIZE(rho_ao_a)
1563 nspinb = SIZE(rho_ao_b)
1564 nspins = min(nspina, nspinb)
1565 DO i = 1, nspins
1566 CALL pw_axpy(tau_r_b(i), tau_r_a(i), beta, alpha)
1567 END DO
1568 END IF
1569
1570 ! tau_g
1571 IF (ASSOCIATED(tau_g_a) .AND. ASSOCIATED(tau_g_b)) THEN
1572 nspina = SIZE(rho_ao_a)
1573 nspinb = SIZE(rho_ao_b)
1574 nspins = min(nspina, nspinb)
1575 DO i = 1, nspins
1576 CALL pw_axpy(tau_g_b(i), tau_g_a(i), beta, alpha)
1577 END DO
1578 END IF
1579
1580 ! tot_rho_r
1581 IF (ASSOCIATED(tot_rho_r_a) .AND. ASSOCIATED(tot_rho_r_b)) THEN
1582 nspina = SIZE(rho_ao_a)
1583 nspinb = SIZE(rho_ao_b)
1584 nspins = min(nspina, nspinb)
1585 DO i = 1, nspins
1586 tot_rho_r_a(i) = alpha*tot_rho_r_a(i) + beta*tot_rho_r_b(i)
1587 END DO
1588 END IF
1589
1590 ! tot_rho_g
1591 IF (ASSOCIATED(tot_rho_g_a) .AND. ASSOCIATED(tot_rho_g_b)) THEN
1592 nspina = SIZE(rho_ao_a)
1593 nspinb = SIZE(rho_ao_b)
1594 nspins = min(nspina, nspinb)
1595 DO i = 1, nspins
1596 tot_rho_g_a(i) = alpha*tot_rho_g_a(i) + beta*tot_rho_g_b(i)
1597 END DO
1598 END IF
1599
1600 CALL timestop(handle)
1601
1602 END SUBROUTINE qs_rho_scale_and_add
1603
1604! **************************************************************************************************
1605!> \brief Duplicates a pointer physically
1606!> \param rho_input The rho structure to be duplicated
1607!> \param rho_output The duplicate rho structure
1608!> \param qs_env The QS environment from which the auxiliary PW basis-set
1609!> pool is taken
1610!> \par History
1611!> 07.2005 initial create [tdk]
1612!> \author Thomas D. Kuehne (tkuehne@phys.chem.ethz.ch)
1613!> \note
1614!> Associated pointers are deallocated, nullified pointers are NOT accepted!
1615! **************************************************************************************************
1616 SUBROUTINE duplicate_rho_type(rho_input, rho_output, qs_env)
1617
1618 TYPE(qs_rho_type), INTENT(INOUT) :: rho_input, rho_output
1619 TYPE(qs_environment_type), POINTER :: qs_env
1620
1621 CHARACTER(len=*), PARAMETER :: routinen = 'duplicate_rho_type'
1622
1623 INTEGER :: handle, i, j, nspins
1624 LOGICAL :: complex_rho_ao_in, drho_g_valid_in, drho_r_valid_in, rho_g_valid_in, &
1625 rho_r_valid_in, soft_valid_in, tau_g_valid_in, tau_r_valid_in
1626 REAL(kind=dp), DIMENSION(:), POINTER :: tot_rho_g_in, tot_rho_g_out, &
1627 tot_rho_r_in, tot_rho_r_out
1628 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_im_in, rho_ao_im_out, rho_ao_in, &
1629 rho_ao_out
1630 TYPE(dft_control_type), POINTER :: dft_control
1631 TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: rho_g_in, rho_g_out, tau_g_in, tau_g_out
1632 TYPE(pw_c1d_gs_type), DIMENSION(:, :), POINTER :: drho_g_in, drho_g_out
1633 TYPE(pw_env_type), POINTER :: pw_env
1634 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1635 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r_in, rho_r_out, tau_r_in, tau_r_out
1636 TYPE(pw_r3d_rs_type), DIMENSION(:, :), POINTER :: drho_r_in, drho_r_out
1637 TYPE(pw_r3d_rs_type), POINTER :: rho_r_sccs_in, rho_r_sccs_out
1638
1639 CALL timeset(routinen, handle)
1640
1641 NULLIFY (dft_control, pw_env, auxbas_pw_pool)
1642 NULLIFY (rho_ao_in, rho_ao_out, rho_ao_im_in, rho_ao_im_out)
1643 NULLIFY (rho_r_in, rho_r_out, rho_g_in, rho_g_out, drho_r_in, drho_r_out)
1644 NULLIFY (drho_g_in, drho_g_out, tau_r_in, tau_r_out, tau_g_in, tau_g_out)
1645 NULLIFY (tot_rho_r_in, tot_rho_r_out, tot_rho_g_in, tot_rho_g_out)
1646 NULLIFY (rho_r_sccs_in, rho_r_sccs_out)
1647
1648 cpassert(ASSOCIATED(qs_env))
1649
1650 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, dft_control=dft_control)
1651 CALL pw_env_get(pw_env=pw_env, auxbas_pw_pool=auxbas_pw_pool)
1652 nspins = dft_control%nspins
1653
1654 CALL qs_rho_clear(rho_output)
1655
1656 CALL qs_rho_get(rho_input, &
1657 rho_ao=rho_ao_in, &
1658 rho_ao_im=rho_ao_im_in, &
1659 rho_r=rho_r_in, &
1660 rho_g=rho_g_in, &
1661 drho_r=drho_r_in, &
1662 drho_g=drho_g_in, &
1663 tau_r=tau_r_in, &
1664 tau_g=tau_g_in, &
1665 tot_rho_r=tot_rho_r_in, &
1666 tot_rho_g=tot_rho_g_in, &
1667 rho_g_valid=rho_g_valid_in, &
1668 rho_r_valid=rho_r_valid_in, &
1669 drho_g_valid=drho_g_valid_in, &
1670 drho_r_valid=drho_r_valid_in, &
1671 tau_r_valid=tau_r_valid_in, &
1672 tau_g_valid=tau_g_valid_in, &
1673 rho_r_sccs=rho_r_sccs_in, &
1674 soft_valid=soft_valid_in, &
1675 complex_rho_ao=complex_rho_ao_in)
1676
1677 ! rho_ao
1678 IF (ASSOCIATED(rho_ao_in)) THEN
1679 CALL dbcsr_allocate_matrix_set(rho_ao_out, nspins)
1680 CALL qs_rho_set(rho_output, rho_ao=rho_ao_out)
1681 DO i = 1, nspins
1682 ALLOCATE (rho_ao_out(i)%matrix)
1683 CALL dbcsr_copy(rho_ao_out(i)%matrix, rho_ao_in(i)%matrix, &
1684 name="myDensityMatrix_for_Spin_"//trim(adjustl(cp_to_string(i))))
1685 CALL dbcsr_set(rho_ao_out(i)%matrix, 0.0_dp)
1686 END DO
1687 END IF
1688
1689 ! rho_ao_im
1690 IF (ASSOCIATED(rho_ao_im_in)) THEN
1691 CALL dbcsr_allocate_matrix_set(rho_ao_im_out, nspins)
1692 CALL qs_rho_set(rho_output, rho_ao=rho_ao_im_out)
1693 DO i = 1, nspins
1694 ALLOCATE (rho_ao_im_out(i)%matrix)
1695 CALL dbcsr_copy(rho_ao_im_out(i)%matrix, rho_ao_im_in(i)%matrix, &
1696 name="myImagDensityMatrix_for_Spin_"//trim(adjustl(cp_to_string(i))))
1697 CALL dbcsr_set(rho_ao_im_out(i)%matrix, 0.0_dp)
1698 END DO
1699 END IF
1700
1701 ! rho_r
1702 IF (ASSOCIATED(rho_r_in)) THEN
1703 ALLOCATE (rho_r_out(nspins))
1704 CALL qs_rho_set(rho_output, rho_r=rho_r_out)
1705 DO i = 1, nspins
1706 CALL auxbas_pw_pool%create_pw(rho_r_out(i))
1707 CALL pw_copy(rho_r_in(i), rho_r_out(i))
1708 END DO
1709 END IF
1710
1711 ! rho_g
1712 IF (ASSOCIATED(rho_g_in)) THEN
1713 ALLOCATE (rho_g_out(nspins))
1714 CALL qs_rho_set(rho_output, rho_g=rho_g_out)
1715 DO i = 1, nspins
1716 CALL auxbas_pw_pool%create_pw(rho_g_out(i))
1717 CALL pw_copy(rho_g_in(i), rho_g_out(i))
1718 END DO
1719 END IF
1720
1721 ! SCCS
1722 IF (ASSOCIATED(rho_r_sccs_in)) THEN
1723 CALL qs_rho_set(rho_output, rho_r_sccs=rho_r_sccs_out)
1724 CALL auxbas_pw_pool%create_pw(rho_r_sccs_out)
1725 CALL pw_copy(rho_r_sccs_in, rho_r_sccs_out)
1726 END IF
1727
1728 ! drho_r and drho_g are only needed if calculated by collocation
1729 IF (dft_control%drho_by_collocation) THEN
1730 ! drho_r
1731 IF (ASSOCIATED(drho_r_in)) THEN
1732 ALLOCATE (drho_r_out(3, nspins))
1733 CALL qs_rho_set(rho_output, drho_r=drho_r_out)
1734 DO j = 1, nspins
1735 DO i = 1, 3
1736 CALL auxbas_pw_pool%create_pw(drho_r_out(i, j))
1737 CALL pw_copy(drho_r_in(i, j), drho_r_out(i, j))
1738 END DO
1739 END DO
1740 END IF
1741
1742 ! drho_g
1743 IF (ASSOCIATED(drho_g_in)) THEN
1744 ALLOCATE (drho_g_out(3, nspins))
1745 CALL qs_rho_set(rho_output, drho_g=drho_g_out)
1746 DO j = 1, nspins
1747 DO i = 1, 3
1748 CALL auxbas_pw_pool%create_pw(drho_g_out(i, j))
1749 CALL pw_copy(drho_g_in(i, j), drho_g_out(i, j))
1750 END DO
1751 END DO
1752 END IF
1753 END IF
1754
1755 ! tau_r and tau_g are only needed in the case of Meta-GGA XC-functionals
1756 ! are used. Therefore they are only allocated if
1757 ! dft_control%use_kinetic_energy_density is true
1758 IF (dft_control%use_kinetic_energy_density) THEN
1759 ! tau_r
1760 IF (ASSOCIATED(tau_r_in)) THEN
1761 ALLOCATE (tau_r_out(nspins))
1762 CALL qs_rho_set(rho_output, tau_r=tau_r_out)
1763 DO i = 1, nspins
1764 CALL auxbas_pw_pool%create_pw(tau_r_out(i))
1765 CALL pw_copy(tau_r_in(i), tau_r_out(i))
1766 END DO
1767 END IF
1768
1769 ! tau_g
1770 IF (ASSOCIATED(tau_g_in)) THEN
1771 ALLOCATE (tau_g_out(nspins))
1772 CALL qs_rho_set(rho_output, tau_g=tau_g_out)
1773 DO i = 1, nspins
1774 CALL auxbas_pw_pool%create_pw(tau_g_out(i))
1775 CALL pw_copy(tau_g_in(i), tau_g_out(i))
1776 END DO
1777 END IF
1778 END IF
1779
1780 CALL qs_rho_set(rho_output, &
1781 rho_g_valid=rho_g_valid_in, &
1782 rho_r_valid=rho_r_valid_in, &
1783 drho_g_valid=drho_g_valid_in, &
1784 drho_r_valid=drho_r_valid_in, &
1785 tau_r_valid=tau_r_valid_in, &
1786 tau_g_valid=tau_g_valid_in, &
1787 soft_valid=soft_valid_in, &
1788 complex_rho_ao=complex_rho_ao_in)
1789
1790 ! tot_rho_r
1791 IF (ASSOCIATED(tot_rho_r_in)) THEN
1792 ALLOCATE (tot_rho_r_out(nspins))
1793 CALL qs_rho_set(rho_output, tot_rho_r=tot_rho_r_out)
1794 DO i = 1, nspins
1795 tot_rho_r_out(i) = tot_rho_r_in(i)
1796 END DO
1797 END IF
1798
1799 ! tot_rho_g
1800 IF (ASSOCIATED(tot_rho_g_in)) THEN
1801 ALLOCATE (tot_rho_g_out(nspins))
1802 CALL qs_rho_set(rho_output, tot_rho_g=tot_rho_g_out)
1803 DO i = 1, nspins
1804 tot_rho_g_out(i) = tot_rho_g_in(i)
1805 END DO
1806
1807 END IF
1808
1809 CALL timestop(handle)
1810
1811 END SUBROUTINE duplicate_rho_type
1812
1813! **************************************************************************************************
1814!> \brief (Re-)allocates rho_ao_im from real part rho_ao
1815!> \param rho ...
1816!> \param qs_env ...
1817! **************************************************************************************************
1818 SUBROUTINE allocate_rho_ao_imag_from_real(rho, qs_env)
1819 TYPE(qs_rho_type), POINTER :: rho
1820 TYPE(qs_environment_type), POINTER :: qs_env
1821
1822 CHARACTER(LEN=default_string_length) :: headline
1823 INTEGER :: i, ic, nimages, nspins
1824 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_im_kp, rho_ao_kp
1825 TYPE(dbcsr_type), POINTER :: template
1826 TYPE(dft_control_type), POINTER :: dft_control
1827 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
1828 POINTER :: sab_orb
1829
1830 NULLIFY (rho_ao_im_kp, rho_ao_kp, dft_control, template, sab_orb)
1831
1832 CALL get_qs_env(qs_env, &
1833 dft_control=dft_control, &
1834 sab_orb=sab_orb)
1835
1836 CALL qs_rho_get(rho, rho_ao_im_kp=rho_ao_im_kp, rho_ao_kp=rho_ao_kp)
1837
1838 nspins = dft_control%nspins
1839 nimages = dft_control%nimages
1840
1841 cpassert(nspins == SIZE(rho_ao_kp, 1))
1842 cpassert(nimages == SIZE(rho_ao_kp, 2))
1843
1844 CALL dbcsr_allocate_matrix_set(rho_ao_im_kp, nspins, nimages)
1845 CALL qs_rho_set(rho, rho_ao_im_kp=rho_ao_im_kp)
1846 DO i = 1, nspins
1847 DO ic = 1, nimages
1848 IF (nspins > 1) THEN
1849 IF (i == 1) THEN
1850 headline = "IMAGINARY PART OF DENSITY MATRIX FOR ALPHA SPIN"
1851 ELSE
1852 headline = "IMAGINARY PART OF DENSITY MATRIX FOR BETA SPIN"
1853 END IF
1854 ELSE
1855 headline = "IMAGINARY PART OF DENSITY MATRIX"
1856 END IF
1857 ALLOCATE (rho_ao_im_kp(i, ic)%matrix)
1858 template => rho_ao_kp(i, ic)%matrix ! base on real part, but anti-symmetric
1859 CALL dbcsr_create(matrix=rho_ao_im_kp(i, ic)%matrix, template=template, &
1860 name=trim(headline), matrix_type=dbcsr_type_antisymmetric)
1861 CALL cp_dbcsr_alloc_block_from_nbl(rho_ao_im_kp(i, ic)%matrix, sab_orb)
1862 CALL dbcsr_set(rho_ao_im_kp(i, ic)%matrix, 0.0_dp)
1863 END DO
1864 END DO
1865
1866 END SUBROUTINE allocate_rho_ao_imag_from_real
1867
1868END MODULE qs_rho_methods
cp_dbcsr_api::dbcsr_create
Definition cp_dbcsr_api.F:194
cp_dbcsr_operations::dbcsr_allocate_matrix_set
Definition cp_dbcsr_operations.F:77
cp_dbcsr_operations::dbcsr_deallocate_matrix_set
Definition cp_dbcsr_operations.F:85
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
pw_methods::pw_axpy
Definition pw_methods.F:165
pw_methods::pw_copy
Definition pw_methods.F:146
pw_methods::pw_scale
Definition pw_methods.F:94
pw_methods::pw_transfer
Definition pw_methods.F:304
pw_methods::pw_zero
Definition pw_methods.F:83
admm_types
Types and set/get functions for auxiliary density matrix methods.
Definition admm_types.F:15
admm_types::get_admm_env
subroutine, public get_admm_env(admm_env, mo_derivs_aux_fit, mos_aux_fit, sab_aux_fit, sab_aux_fit_asymm, sab_aux_fit_vs_orb, matrix_s_aux_fit, matrix_s_aux_fit_kp, matrix_s_aux_fit_vs_orb, matrix_s_aux_fit_vs_orb_kp, task_list_aux_fit, matrix_ks_aux_fit, matrix_ks_aux_fit_kp, matrix_ks_aux_fit_im, matrix_ks_aux_fit_dft, matrix_ks_aux_fit_hfx, matrix_ks_aux_fit_dft_kp, matrix_ks_aux_fit_hfx_kp, rho_aux_fit, rho_aux_fit_buffer, admm_dm)
Get routine for the ADMM env.
Definition admm_types.F:599
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
cp_control_types
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Definition cp_control_types.F:12
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_scale
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
Definition cp_dbcsr_api.F:1188
cp_dbcsr_api::dbcsr_copy
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
Definition cp_dbcsr_api.F:371
cp_dbcsr_api::dbcsr_set
subroutine, public dbcsr_set(matrix, alpha)
...
Definition cp_dbcsr_api.F:1204
cp_dbcsr_api::dbcsr_add
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
Definition cp_dbcsr_api.F:254
cp_dbcsr_cp2k_link
Routines that link DBCSR and CP2K concepts together.
Definition cp_dbcsr_cp2k_link.F:14
cp_dbcsr_cp2k_link::cp_dbcsr_alloc_block_from_nbl
subroutine, public cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize)
allocate the blocks of a dbcsr based on the neighbor list
Definition cp_dbcsr_cp2k_link.F:445
cp_dbcsr_operations
DBCSR operations in CP2K.
Definition cp_dbcsr_operations.F:18
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
kpoint_types
Types and basic routines needed for a kpoint calculation.
Definition kpoint_types.F:15
kpoint_types::get_kpoint_info
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered, lattice_fft)
Retrieve information from a kpoint environment.
Definition kpoint_types.F:544
lri_environment_methods
Calculates integral matrices for LRIGPW method lri : local resolution of the identity.
Definition lri_environment_methods.F:18
lri_environment_methods::calculate_lri_densities
subroutine, public calculate_lri_densities(lri_env, lri_density, qs_env, pmatrix, cell_to_index, lri_rho_struct, atomic_kind_set, para_env, response_density)
performs the fitting of the density and distributes the fitted density on the grid
Definition lri_environment_methods.F:569
lri_environment_types
contains the types and subroutines for dealing with the lri_env lri : local resolution of the identit...
Definition lri_environment_types.F:18
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:27
pw_env_types
container for various plainwaves related things
Definition pw_env_types.F:14
pw_env_types::pw_env_get
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
Definition pw_env_types.F:113
pw_methods
Definition pw_methods.F:25
pw_pool_types
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Definition pw_pool_types.F:24
pw_types
Definition pw_types.F:24
qs_collocate_density
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
Definition qs_collocate_density.F:38
qs_collocate_density::calculate_drho_elec
subroutine, public calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env, soft_valid, basis_type)
computes the gradient of the density corresponding to a given density matrix on the grid
Definition qs_collocate_density.F:1886
qs_collocate_density::calculate_rho_elec
subroutine, public calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho, ks_env, soft_valid, compute_tau, compute_grad, basis_type, der_type, idir, task_list_external, pw_env_external)
computes the density corresponding to a given density matrix on the grid
Definition qs_collocate_density.F:1720
qs_environment_types
Definition qs_environment_types.F:14
qs_environment_types::get_qs_env
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_vhxc, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Definition qs_environment_types.F:542
qs_environment_types::set_qs_env
subroutine, public set_qs_env(qs_env, super_cell, mos, qmmm, qmmm_periodic, mimic, ewald_env, ewald_pw, mpools, rho_external, external_vxc, mask, scf_control, rel_control, qs_charges, ks_env, ks_qmmm_env, wf_history, scf_env, active_space, input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, efield, rhoz_cneo_set, linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, ls_scf_env, do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, harris_env, gcp_env, mp2_env, bs_env, kg_env, force, kpoints, wanniercentres, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Set the QUICKSTEP environment.
Definition qs_environment_types.F:1131
qs_harris_types
Types needed for a for a Harris model calculation.
Definition qs_harris_types.F:14
qs_harris_utils
Harris method environment setup and handling.
Definition qs_harris_utils.F:14
qs_harris_utils::calculate_harris_density
subroutine, public calculate_harris_density(qs_env, harris_env, rho_struct)
...
Definition qs_harris_utils.F:361
qs_kind_types
Define the quickstep kind type and their sub types.
Definition qs_kind_types.F:23
qs_ks_types
Definition qs_ks_types.F:15
qs_ks_types::get_ks_env
subroutine, public get_ks_env(ks_env, v_hartree_rspace, s_mstruct_changed, rho_changed, exc_accint, potential_changed, forces_up_to_date, complex_ks, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, kinetic, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_vhxc, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_ks_im_kp, rho, rho_xc, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, vee, neighbor_list_id, sab_orb, sab_all, sac_ae, sac_ppl, sac_lri, sap_ppnl, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_vdw, sab_scp, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, task_list, task_list_soft, kpoints, do_kpoints, atomic_kind_set, qs_kind_set, cell, cell_ref, use_ref_cell, particle_set, energy, force, local_particles, local_molecules, molecule_kind_set, molecule_set, subsys, cp_subsys, virial, results, atprop, nkind, natom, dft_control, dbcsr_dist, distribution_2d, pw_env, para_env, blacs_env, nelectron_total, nelectron_spin)
...
Definition qs_ks_types.F:343
qs_local_rho_types
Definition qs_local_rho_types.F:8
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition qs_neighbor_list_types.F:17
qs_oce_types
Definition qs_oce_types.F:8
qs_rho_atom_methods
Definition qs_rho_atom_methods.F:7
qs_rho_atom_methods::calculate_rho_atom_coeff
subroutine, public calculate_rho_atom_coeff(qs_env, rho_ao, rho_atom_set, qs_kind_set, oce, sab, para_env)
...
Definition qs_rho_atom_methods.F:561
qs_rho_atom_types
Definition qs_rho_atom_types.F:8
qs_rho_methods
methods of the rho structure (defined in qs_rho_types)
Definition qs_rho_methods.F:15
qs_rho_methods::qs_rho_update_tddfpt
subroutine, public qs_rho_update_tddfpt(rho_struct, qs_env, pw_env_external, task_list_external, para_env_external, tddfpt_lri_env, tddfpt_lri_density)
updates rho_r and rho_g to the rhorho_ao. if use_kinetic_energy_density also computes tau_r and tau_g
Definition qs_rho_methods.F:682
qs_rho_methods::qs_rho_copy
subroutine, public qs_rho_copy(rho_input, rho_output, auxbas_pw_pool, mspin, factor)
Allocate a density structure and fill it with data from an input structure SIZE(rho_input) == mspin =...
Definition qs_rho_methods.F:779
qs_rho_methods::allocate_rho_ao_imag_from_real
subroutine, public allocate_rho_ao_imag_from_real(rho, qs_env)
(Re-)allocates rho_ao_im from real part rho_ao
Definition qs_rho_methods.F:1819
qs_rho_methods::qs_rho_update_rho
subroutine, public qs_rho_update_rho(rho_struct, qs_env, rho_xc_external, local_rho_set, task_list_external, task_list_external_soft, pw_env_external, para_env_external)
updates rho_r and rho_g to the rhorho_ao. if use_kinetic_energy_density also computes tau_r and tau_g...
Definition qs_rho_methods.F:381
qs_rho_methods::duplicate_rho_type
subroutine, public duplicate_rho_type(rho_input, rho_output, qs_env)
Duplicates a pointer physically.
Definition qs_rho_methods.F:1617
qs_rho_methods::qs_rho_scale_and_add_b
subroutine, public qs_rho_scale_and_add_b(rhoa, rhob, alpha, beta)
rhoa(2) = alpha*rhoa(2)+beta*rhob(1)
Definition qs_rho_methods.F:1328
qs_rho_methods::qs_rho_scale_and_add
subroutine, public qs_rho_scale_and_add(rhoa, rhob, alpha, beta)
rhoa = alpha*rhoa+beta*rhob
Definition qs_rho_methods.F:1445
qs_rho_methods::qs_rho_transfer
subroutine, public qs_rho_transfer(rho_input, rho_output, in_pw_pool, out_pw_pool)
Allocate a density structure and fill it with data from an input structure Transfer all data to input...
Definition qs_rho_methods.F:1078
qs_rho_methods::qs_rho_rebuild
subroutine, public qs_rho_rebuild(rho, qs_env, rebuild_ao, rebuild_grids, admm, pw_env_external)
rebuilds rho (if necessary allocating and initializing it)
Definition qs_rho_methods.F:100
qs_rho_types
superstucture that hold various representations of the density and keeps track of which ones are vali...
Definition qs_rho_types.F:18
qs_rho_types::qs_rho_set
subroutine, public qs_rho_set(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
...
Definition qs_rho_types.F:308
qs_rho_types::qs_rho_get
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
Definition qs_rho_types.F:229
qs_rho_types::qs_rho_clear
subroutine, public qs_rho_clear(rho_struct)
Deallocates all components, without deallocating rho_struct itself.
Definition qs_rho_types.F:127
ri_environment_methods
Calculates integral matrices for RIGPW method.
Definition ri_environment_methods.F:18
ri_environment_methods::calculate_ri_densities
subroutine, public calculate_ri_densities(lri_env, qs_env, pmatrix, lri_rho_struct, atomic_kind_set, para_env)
performs the fitting of the density and distributes the fitted density on the grid
Definition ri_environment_methods.F:358
task_list_types
types for task lists
Definition task_list_types.F:14
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
cp_control_types::dft_control_type
Definition cp_control_types.F:758
cp_dbcsr_api::dbcsr_p_type
Definition cp_dbcsr_api.F:172
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:176
kpoint_types::kpoint_type
Contains information about kpoints.
Definition kpoint_types.F:187
lri_environment_types::lri_density_type
Definition lri_environment_types.F:359
lri_environment_types::lri_environment_type
Definition lri_environment_types.F:271
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:767
pw_env_types::pw_env_type
contained for different pw related things
Definition pw_env_types.F:70
pw_pool_types::pw_pool_type
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Definition pw_pool_types.F:83
pw_types::pw_c1d_gs_type
Definition pw_types.F:127
pw_types::pw_r3d_rs_type
Definition pw_types.F:62
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:224
qs_harris_types::harris_type
Contains information on the Harris method.
Definition qs_harris_types.F:66
qs_kind_types::qs_kind_type
Provides all information about a quickstep kind.
Definition qs_kind_types.F:190
qs_ks_types::qs_ks_env_type
calculation environment to calculate the ks matrix, holds all the needed vars. assumes that the core ...
Definition qs_ks_types.F:137
qs_local_rho_types::local_rho_type
Definition qs_local_rho_types.F:45
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
qs_oce_types::oce_matrix_type
Definition qs_oce_types.F:37
qs_rho_atom_types::rho_atom_type
Definition qs_rho_atom_types.F:23
qs_rho_types::qs_rho_type
keeps the density in various representations, keeping track of which ones are valid.
Definition qs_rho_types.F:62
task_list_types::task_list_type
Definition task_list_types.F:58