Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : MODULE qs_tddfpt2_types
9 : USE admm_types, ONLY: admm_type,&
10 : get_admm_env
11 : USE atomic_kind_types, ONLY: atomic_kind_type
12 : USE cp_blacs_env, ONLY: cp_blacs_env_type
13 : USE cp_control_types, ONLY: dft_control_type
14 : USE cp_dbcsr_api, ONLY: &
15 : dbcsr_complete_redistribute, dbcsr_create, dbcsr_deallocate_matrix, &
16 : dbcsr_distribution_type, dbcsr_get_info, dbcsr_init_p, dbcsr_p_type, dbcsr_release_p, &
17 : dbcsr_type, dbcsr_type_antisymmetric
18 : USE cp_dbcsr_operations, ONLY: cp_dbcsr_sm_fm_multiply,&
19 : dbcsr_allocate_matrix_set,&
20 : dbcsr_deallocate_matrix_set
21 : USE cp_fm_pool_types, ONLY: cp_fm_pool_p_type,&
22 : fm_pool_create,&
23 : fm_pool_create_fm,&
24 : fm_pool_release
25 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
26 : cp_fm_struct_p_type,&
27 : cp_fm_struct_release,&
28 : cp_fm_struct_type
29 : USE cp_fm_types, ONLY: cp_fm_create,&
30 : cp_fm_release,&
31 : cp_fm_type
32 : USE ewald_environment_types, ONLY: ewald_env_release,&
33 : ewald_environment_type
34 : USE ewald_pw_types, ONLY: ewald_pw_release,&
35 : ewald_pw_type
36 : USE hartree_local_methods, ONLY: init_coulomb_local
37 : USE hartree_local_types, ONLY: hartree_local_create,&
38 : hartree_local_release,&
39 : hartree_local_type
40 : USE kinds, ONLY: dp
41 : USE message_passing, ONLY: mp_para_env_type
42 : USE parallel_gemm_api, ONLY: parallel_gemm
43 : USE pw_env_types, ONLY: pw_env_get
44 : USE pw_pool_types, ONLY: pw_pool_type
45 : USE pw_types, ONLY: pw_c1d_gs_type,&
46 : pw_r3d_rs_type
47 : USE qs_environment_types, ONLY: get_qs_env,&
48 : qs_environment_type
49 : USE qs_kind_types, ONLY: qs_kind_type
50 : USE qs_local_rho_types, ONLY: local_rho_set_create,&
51 : local_rho_set_release,&
52 : local_rho_type
53 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
54 : USE qs_rho0_ggrid, ONLY: rho0_s_grid_create
55 : USE qs_rho0_methods, ONLY: init_rho0
56 : USE qs_rho_atom_methods, ONLY: allocate_rho_atom_internals
57 : USE qs_rho_methods, ONLY: qs_rho_rebuild
58 : USE qs_rho_types, ONLY: qs_rho_create,&
59 : qs_rho_release,&
60 : qs_rho_set,&
61 : qs_rho_type
62 : USE qs_tddfpt2_subgroups, ONLY: tddfpt_dbcsr_create_by_dist,&
63 : tddfpt_subgroup_env_type
64 : #include "./base/base_uses.f90"
65 :
66 : IMPLICIT NONE
67 :
68 : PRIVATE
69 :
70 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_types'
71 :
72 : LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE.
73 : ! number of first derivative components (3: d/dx, d/dy, d/dz)
74 : INTEGER, PARAMETER, PRIVATE :: nderivs = 3
75 : INTEGER, PARAMETER, PRIVATE :: maxspins = 2
76 :
77 : PUBLIC :: tddfpt_ground_state_mos, tddfpt_work_matrices
78 : PUBLIC :: tddfpt_create_work_matrices, stda_create_work_matrices, tddfpt_release_work_matrices
79 : PUBLIC :: hfxsr_create_work_matrices
80 :
81 : ! **************************************************************************************************
82 : !> \brief Ground state molecular orbitals.
83 : !> \par History
84 : !> * 06.2016 created [Sergey Chulkov]
85 : ! **************************************************************************************************
86 : TYPE tddfpt_ground_state_mos
87 : !> occupied MOs stored in a matrix form [nao x nmo_occ]
88 : TYPE(cp_fm_type), POINTER :: mos_occ => NULL()
89 : !> virtual MOs stored in a matrix form [nao x nmo_virt]
90 : TYPE(cp_fm_type), POINTER :: mos_virt => NULL()
91 : !> negated occupied orbital energy matrix [nmo_occ x nmo_occ]: - mos_occ^T * KS * mos_occ .
92 : !> Allocated when orbital energy correction is in use, otherwise it is just a diagonal
93 : !> matrix with 'evals_occ' on its diagonal
94 : TYPE(cp_fm_type), POINTER :: evals_occ_matrix => NULL()
95 : !> (non-corrected) occupied orbital energies
96 : REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: evals_occ
97 : !> (non-corrected) virtual orbital energies
98 : REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: evals_virt
99 : !> phase of occupied MOs; +1.0 -- positive, -1.0 -- negative;
100 : !> it is mainly needed to make the restart file transferable
101 : REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: phases_occ
102 : REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: phases_virt
103 : END TYPE tddfpt_ground_state_mos
104 :
105 : ! **************************************************************************************************
106 : !> \brief Set of temporary ("work") matrices.
107 : !> \par History
108 : !> * 01.2017 created [Sergey Chulkov]
109 : ! **************************************************************************************************
110 : TYPE tddfpt_work_matrices
111 : !
112 : ! *** globally distributed dense matrices ***
113 : !
114 : !> pool of dense [nao x nmo_occ(spin)] matrices;
115 : !> used mainly to dynamically expand the list of trial vectors
116 : TYPE(cp_fm_pool_p_type), ALLOCATABLE, DIMENSION(:) :: fm_pool_ao_mo_occ
117 : !> S * mos_occ(spin)
118 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: S_C0
119 : !> S * \rho_0(spin)
120 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: S_C0_C0T
121 : !
122 : ! *** dense matrices distributed across parallel (sub)groups ***
123 : !
124 : !> evects_sub(1:nspins, 1:nstates): a copy of the last 'nstates' trial vectors distributed
125 : !> across parallel (sub)groups. Here 'nstates' is the number of requested excited states which
126 : !> is typically much smaller than the total number of Krylov's vectors. Allocated only if
127 : !> the number of parallel groups > 1, otherwise we use the original globally distributed vectors.
128 : !> evects_sub(spin, state) == null() means that the trial vector is assigned to a different (sub)group
129 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: evects_sub
130 : !> action of TDDFPT operator on trial vectors distributed across parallel (sub)groups
131 : TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: Aop_evects_sub
132 : !> electron density expressed in terms of atomic orbitals using primary basis set
133 : TYPE(cp_fm_type), POINTER :: rho_ao_orb_fm_sub => NULL()
134 : !
135 : ! NOTE: we do not need the next 2 matrices in case of a sparse matrix 'tddfpt_subgroup_env_type%admm_A'
136 : !
137 : !> electron density expressed in terms of atomic orbitals using auxiliary basis set;
138 : !> can be seen as a group-specific version of the matrix 'admm_type%work_aux_aux'
139 : TYPE(cp_fm_type), POINTER :: rho_ao_aux_fit_fm_sub => NULL()
140 : !> group-specific version of the matrix 'admm_type%work_aux_orb' with shape [nao_aux x nao]
141 : TYPE(cp_fm_type), POINTER :: wfm_aux_orb_sub => NULL()
142 : !
143 : ! *** sparse matrices distributed across parallel (sub)groups ***
144 : !
145 : !> sparse matrix with shape [nao x nao] distributed across subgroups;
146 : !> Aop_evects_sub(spin,:) = A_ia_munu_sub(spin) * mos_occ(spin)
147 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: A_ia_munu_sub => NULL()
148 : !
149 : ! *** structures to store electron densities distributed across parallel (sub)groups ***
150 : !
151 : !> electron density in terms of primary basis set
152 : TYPE(qs_rho_type), POINTER :: rho_orb_struct_sub => NULL()
153 : !> electron density for XC in GAPW_XC
154 : TYPE(qs_rho_type), POINTER :: rho_xc_struct_sub => NULL()
155 : !> electron density in terms of auxiliary basis set
156 : TYPE(qs_rho_type), POINTER :: rho_aux_fit_struct_sub => NULL()
157 : !> group-specific copy of a Coulomb/xc-potential on a real-space grid
158 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: A_ia_rspace_sub => NULL()
159 : !> group-specific copy of a reciprocal-space grid
160 : TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER :: wpw_gspace_sub => NULL()
161 : !> group-specific copy of a real-space grid
162 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: wpw_rspace_sub => NULL()
163 : !> group-specific copy of a real-space grid for the kinetic energy density
164 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: wpw_tau_rspace_sub => NULL()
165 : !
166 : ! *** real space pw grid to hold fxc kernel <> A_ia_rspace_sub ***
167 : !
168 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: fxc_rspace_sub => NULL()
169 : !
170 : ! *** globally distributed matrices required to compute exact exchange terms ***
171 : !
172 : !> globally distributed version of the matrix 'rho_ao_orb_fm_sub' to store the electron density
173 : TYPE(cp_fm_type), POINTER :: hfx_fm_ao_ao => NULL()
174 : !> sparse matrix to store the electron density in terms of auxiliary (ADMM calculation)
175 : !> or primary (regular calculation) basis set
176 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfx_rho_ao_symm => NULL(), hfx_rho_ao_asymm => NULL()
177 : !> exact exchange expressed in terms of auxiliary or primary basis set
178 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfx_hmat_symm => NULL(), hfx_hmat_asymm => NULL()
179 : !> SR exact exchage matrices
180 : TYPE(cp_fm_type), POINTER :: hfxsr_fm_ao_ao => NULL()
181 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfxsr_rho_ao_symm => NULL(), hfxsr_rho_ao_asymm => NULL()
182 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfxsr_hmat_symm => NULL(), hfxsr_hmat_asymm => NULL()
183 : !
184 : ! *** matrices required for sTDA kernel, all matrices are within subgroups
185 : !
186 : ! Short-range gamma exchange matrix
187 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: gamma_exchange => NULL()
188 : !Lowdin MO coefficients: NAO*NOCC
189 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: ctransformed => NULL()
190 : !S^1/2
191 : TYPE(dbcsr_type), POINTER :: shalf => NULL()
192 : !Eigenvalues/eigenvectors of the overlap matrix, used in sTDA forces (Lowdin derivatives)
193 : REAL(KIND=dp), DIMENSION(:), POINTER :: S_eigenvalues => NULL()
194 : TYPE(cp_fm_type), POINTER :: S_eigenvectors => NULL()
195 : TYPE(cp_fm_type), POINTER :: slambda => NULL()
196 : !Ewald environments
197 : TYPE(ewald_environment_type), POINTER :: ewald_env => NULL()
198 : TYPE(ewald_pw_type), POINTER :: ewald_pw => NULL()
199 : !> GAPW local atomic grids
200 : TYPE(hartree_local_type), POINTER :: hartree_local => NULL()
201 : TYPE(local_rho_type), POINTER :: local_rho_set => NULL()
202 : TYPE(local_rho_type), POINTER :: local_rho_set_admm => NULL()
203 : END TYPE tddfpt_work_matrices
204 :
205 : CONTAINS
206 :
207 : ! **************************************************************************************************
208 : !> \brief Allocate work matrices for full kernel
209 : !> \param work_matrices work matrices (allocated on exit)
210 : !> \param gs_mos occupied and virtual molecular orbitals optimised for the ground state
211 : !> \param nstates number of excited states to converge
212 : !> \param do_hfx flag that requested to allocate work matrices required for computation
213 : !> of exact-exchange terms
214 : !> \param do_admm ...
215 : !> \param do_hfxlr ...
216 : !> \param do_exck ...
217 : !> \param qs_env Quickstep environment
218 : !> \param sub_env parallel group environment
219 : !> \par History
220 : !> * 02.2017 created [Sergey Chulkov]
221 : ! **************************************************************************************************
222 1176 : SUBROUTINE tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, do_admm, &
223 : do_hfxlr, do_exck, qs_env, sub_env)
224 : TYPE(tddfpt_work_matrices), INTENT(out) :: work_matrices
225 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
226 : INTENT(in) :: gs_mos
227 : INTEGER, INTENT(in) :: nstates
228 : LOGICAL, INTENT(in) :: do_hfx, do_admm, do_hfxlr, do_exck
229 : TYPE(qs_environment_type), POINTER :: qs_env
230 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
231 :
232 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_create_work_matrices'
233 :
234 : INTEGER :: handle, igroup, ispin, istate, nao, &
235 : nao_aux, natom, ngroups, nspins
236 : INTEGER, DIMENSION(maxspins) :: nmo_occ, nmo_virt
237 : TYPE(admm_type), POINTER :: admm_env
238 588 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
239 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
240 1764 : TYPE(cp_fm_struct_p_type), DIMENSION(maxspins) :: fm_struct_evects
241 : TYPE(cp_fm_struct_type), POINTER :: fm_struct
242 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
243 588 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, matrix_s_aux_fit, rho_ia_ao, &
244 588 : rho_xc_ao
245 : TYPE(dbcsr_type), POINTER :: dbcsr_template_hfx
246 : TYPE(dft_control_type), POINTER :: dft_control
247 : TYPE(mp_para_env_type), POINTER :: para_env
248 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
249 588 : POINTER :: sab_hfx
250 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
251 588 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
252 :
253 588 : CALL timeset(routineN, handle)
254 :
255 : ! sTDA
256 588 : NULLIFY (work_matrices%shalf)
257 588 : NULLIFY (work_matrices%ewald_env)
258 588 : NULLIFY (work_matrices%ewald_pw)
259 588 : NULLIFY (work_matrices%gamma_exchange)
260 588 : NULLIFY (work_matrices%ctransformed)
261 588 : NULLIFY (work_matrices%S_eigenvalues)
262 588 : NULLIFY (work_matrices%S_eigenvectors)
263 588 : NULLIFY (work_matrices%slambda)
264 :
265 : ! GAPW
266 588 : NULLIFY (work_matrices%hartree_local)
267 588 : NULLIFY (work_matrices%local_rho_set)
268 588 : NULLIFY (work_matrices%local_rho_set_admm)
269 :
270 : ! EXCK
271 588 : NULLIFY (work_matrices%rho_xc_struct_sub)
272 :
273 588 : nspins = SIZE(gs_mos)
274 588 : CALL get_qs_env(qs_env, blacs_env=blacs_env, matrix_s=matrix_s)
275 588 : CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
276 :
277 1268 : DO ispin = 1, nspins
278 680 : nmo_occ(ispin) = SIZE(gs_mos(ispin)%evals_occ)
279 588 : nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
280 : END DO
281 :
282 588 : IF (do_admm) THEN
283 124 : CPASSERT(do_hfx)
284 124 : CPASSERT(ASSOCIATED(sub_env%admm_A))
285 124 : CALL get_admm_env(qs_env%admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
286 124 : CALL dbcsr_get_info(matrix_s_aux_fit(1)%matrix, nfullrows_total=nao_aux)
287 : END IF
288 :
289 588 : NULLIFY (fm_struct)
290 2444 : ALLOCATE (work_matrices%fm_pool_ao_mo_occ(nspins))
291 1268 : DO ispin = 1, nspins
292 680 : NULLIFY (work_matrices%fm_pool_ao_mo_occ(ispin)%pool)
293 680 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nmo_occ(ispin), context=blacs_env)
294 680 : CALL fm_pool_create(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, fm_struct)
295 1268 : CALL cp_fm_struct_release(fm_struct)
296 : END DO
297 :
298 2444 : ALLOCATE (work_matrices%S_C0_C0T(nspins))
299 588 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
300 1268 : DO ispin = 1, nspins
301 1268 : CALL cp_fm_create(work_matrices%S_C0_C0T(ispin), fm_struct)
302 : END DO
303 588 : CALL cp_fm_struct_release(fm_struct)
304 :
305 1856 : ALLOCATE (work_matrices%S_C0(nspins))
306 1268 : DO ispin = 1, nspins
307 680 : CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, work_matrices%S_C0(ispin))
308 :
309 : CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, gs_mos(ispin)%mos_occ, work_matrices%S_C0(ispin), &
310 680 : ncol=nmo_occ(ispin), alpha=1.0_dp, beta=0.0_dp)
311 : CALL parallel_gemm('N', 'T', nao, nao, nmo_occ(ispin), 1.0_dp, work_matrices%S_C0(ispin), &
312 1268 : gs_mos(ispin)%mos_occ, 0.0_dp, work_matrices%S_C0_C0T(ispin))
313 : END DO
314 :
315 588 : IF (sub_env%is_split) THEN
316 4 : DO ispin = 1, nspins
317 : CALL cp_fm_struct_create(fm_struct_evects(ispin)%struct, nrow_global=nao, &
318 4 : ncol_global=nmo_occ(ispin), context=sub_env%blacs_env)
319 : END DO
320 :
321 28 : ALLOCATE (work_matrices%evects_sub(nspins, nstates), work_matrices%Aop_evects_sub(nspins, nstates))
322 :
323 2 : CALL blacs_env%get(para_env=para_env)
324 2 : igroup = sub_env%group_distribution(para_env%mepos)
325 2 : ngroups = sub_env%ngroups
326 :
327 4 : DO istate = ngroups - igroup, nstates, ngroups
328 6 : DO ispin = 1, nspins
329 2 : CALL cp_fm_create(work_matrices%evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
330 4 : CALL cp_fm_create(work_matrices%Aop_evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
331 : END DO
332 : END DO
333 :
334 4 : DO ispin = nspins, 1, -1
335 4 : CALL cp_fm_struct_release(fm_struct_evects(ispin)%struct)
336 : END DO
337 : END IF
338 :
339 588 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=sub_env%blacs_env)
340 588 : ALLOCATE (work_matrices%rho_ao_orb_fm_sub)
341 588 : CALL cp_fm_create(work_matrices%rho_ao_orb_fm_sub, fm_struct)
342 588 : CALL cp_fm_struct_release(fm_struct)
343 :
344 588 : NULLIFY (work_matrices%rho_ao_aux_fit_fm_sub, work_matrices%wfm_aux_orb_sub)
345 588 : IF (do_admm) THEN
346 124 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao_aux, ncol_global=nao_aux, context=sub_env%blacs_env)
347 124 : ALLOCATE (work_matrices%rho_ao_aux_fit_fm_sub)
348 124 : CALL cp_fm_create(work_matrices%rho_ao_aux_fit_fm_sub, fm_struct)
349 124 : CALL cp_fm_struct_release(fm_struct)
350 :
351 124 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao_aux, ncol_global=nao, context=sub_env%blacs_env)
352 124 : ALLOCATE (work_matrices%wfm_aux_orb_sub)
353 124 : CALL cp_fm_create(work_matrices%wfm_aux_orb_sub, fm_struct)
354 124 : CALL cp_fm_struct_release(fm_struct)
355 : END IF
356 :
357 : ! group-specific dbcsr matrices
358 588 : NULLIFY (work_matrices%A_ia_munu_sub)
359 588 : CALL dbcsr_allocate_matrix_set(work_matrices%A_ia_munu_sub, nspins)
360 1268 : DO ispin = 1, nspins
361 680 : CALL dbcsr_init_p(work_matrices%A_ia_munu_sub(ispin)%matrix)
362 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%A_ia_munu_sub(ispin)%matrix, template=matrix_s(1)%matrix, &
363 1268 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_orb)
364 : END DO
365 :
366 : ! group-specific response density
367 588 : NULLIFY (rho_ia_ao)
368 588 : CALL dbcsr_allocate_matrix_set(rho_ia_ao, nspins)
369 1268 : DO ispin = 1, nspins
370 680 : CALL dbcsr_init_p(rho_ia_ao(ispin)%matrix)
371 : CALL tddfpt_dbcsr_create_by_dist(rho_ia_ao(ispin)%matrix, template=matrix_s(1)%matrix, &
372 1268 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_orb)
373 : END DO
374 :
375 : NULLIFY (work_matrices%rho_orb_struct_sub)
376 588 : ALLOCATE (work_matrices%rho_orb_struct_sub)
377 588 : CALL qs_rho_create(work_matrices%rho_orb_struct_sub)
378 588 : CALL qs_rho_set(work_matrices%rho_orb_struct_sub, rho_ao=rho_ia_ao)
379 : CALL qs_rho_rebuild(work_matrices%rho_orb_struct_sub, qs_env, rebuild_ao=.FALSE., &
380 588 : rebuild_grids=.TRUE., pw_env_external=sub_env%pw_env)
381 588 : CALL get_qs_env(qs_env, dft_control=dft_control)
382 588 : IF (dft_control%qs_control%gapw_xc) THEN
383 36 : NULLIFY (rho_xc_ao)
384 36 : CALL dbcsr_allocate_matrix_set(rho_xc_ao, nspins)
385 72 : DO ispin = 1, nspins
386 36 : CALL dbcsr_init_p(rho_xc_ao(ispin)%matrix)
387 : CALL tddfpt_dbcsr_create_by_dist(rho_xc_ao(ispin)%matrix, template=matrix_s(1)%matrix, &
388 72 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_orb)
389 : END DO
390 : NULLIFY (work_matrices%rho_xc_struct_sub)
391 36 : ALLOCATE (work_matrices%rho_xc_struct_sub)
392 36 : CALL qs_rho_create(work_matrices%rho_xc_struct_sub)
393 36 : CALL qs_rho_set(work_matrices%rho_xc_struct_sub, rho_ao=rho_xc_ao)
394 : CALL qs_rho_rebuild(work_matrices%rho_xc_struct_sub, qs_env, rebuild_ao=.FALSE., &
395 36 : rebuild_grids=.TRUE., pw_env_external=sub_env%pw_env)
396 : END IF
397 :
398 588 : NULLIFY (work_matrices%rho_aux_fit_struct_sub)
399 588 : IF (do_admm) THEN
400 124 : NULLIFY (rho_ia_ao)
401 124 : CALL dbcsr_allocate_matrix_set(rho_ia_ao, nspins)
402 252 : DO ispin = 1, nspins
403 128 : CALL dbcsr_init_p(rho_ia_ao(ispin)%matrix)
404 : CALL tddfpt_dbcsr_create_by_dist(rho_ia_ao(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix, &
405 252 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_aux_fit)
406 : END DO
407 :
408 124 : ALLOCATE (work_matrices%rho_aux_fit_struct_sub)
409 124 : CALL qs_rho_create(work_matrices%rho_aux_fit_struct_sub)
410 124 : CALL qs_rho_set(work_matrices%rho_aux_fit_struct_sub, rho_ao=rho_ia_ao)
411 : CALL qs_rho_rebuild(work_matrices%rho_aux_fit_struct_sub, qs_env, rebuild_ao=.FALSE., &
412 124 : rebuild_grids=.TRUE., pw_env_external=sub_env%pw_env)
413 : END IF
414 :
415 : ! work plain-wave grids
416 588 : CALL pw_env_get(sub_env%pw_env, auxbas_pw_pool=auxbas_pw_pool)
417 2444 : ALLOCATE (work_matrices%A_ia_rspace_sub(nspins))
418 : ALLOCATE (work_matrices%wpw_gspace_sub(nspins), work_matrices%wpw_rspace_sub(nspins), &
419 4980 : work_matrices%wpw_tau_rspace_sub(nspins))
420 1268 : DO ispin = 1, nspins
421 680 : CALL auxbas_pw_pool%create_pw(work_matrices%A_ia_rspace_sub(ispin))
422 680 : CALL auxbas_pw_pool%create_pw(work_matrices%wpw_gspace_sub(ispin))
423 680 : CALL auxbas_pw_pool%create_pw(work_matrices%wpw_rspace_sub(ispin))
424 1268 : CALL auxbas_pw_pool%create_pw(work_matrices%wpw_tau_rspace_sub(ispin))
425 : END DO
426 :
427 : ! fxc kernel potential real space grid
428 588 : IF (do_exck) THEN
429 : ! we need spins: aa, ab, bb
430 48 : ALLOCATE (work_matrices%fxc_rspace_sub(3))
431 48 : DO ispin = 1, 3
432 48 : CALL auxbas_pw_pool%create_pw(work_matrices%fxc_rspace_sub(ispin))
433 : END DO
434 : ELSE
435 576 : NULLIFY (work_matrices%fxc_rspace_sub)
436 : END IF
437 :
438 : ! GAPW initializations
439 588 : IF (dft_control%qs_control%gapw) THEN
440 : CALL get_qs_env(qs_env, &
441 : atomic_kind_set=atomic_kind_set, &
442 : natom=natom, &
443 174 : qs_kind_set=qs_kind_set)
444 174 : CALL local_rho_set_create(work_matrices%local_rho_set)
445 : CALL allocate_rho_atom_internals(work_matrices%local_rho_set%rho_atom_set, atomic_kind_set, &
446 174 : qs_kind_set, dft_control, sub_env%para_env)
447 : CALL init_rho0(work_matrices%local_rho_set, qs_env, dft_control%qs_control%gapw_control, &
448 174 : zcore=0.0_dp)
449 174 : CALL rho0_s_grid_create(sub_env%pw_env, work_matrices%local_rho_set%rho0_mpole)
450 174 : CALL hartree_local_create(work_matrices%hartree_local)
451 174 : CALL init_coulomb_local(work_matrices%hartree_local, natom)
452 414 : ELSEIF (dft_control%qs_control%gapw_xc) THEN
453 : CALL get_qs_env(qs_env, &
454 : atomic_kind_set=atomic_kind_set, &
455 36 : qs_kind_set=qs_kind_set)
456 36 : CALL local_rho_set_create(work_matrices%local_rho_set)
457 : CALL allocate_rho_atom_internals(work_matrices%local_rho_set%rho_atom_set, atomic_kind_set, &
458 36 : qs_kind_set, dft_control, sub_env%para_env)
459 : END IF
460 :
461 : ! HFX-related globally distributed matrices
462 588 : NULLIFY (work_matrices%hfx_fm_ao_ao, work_matrices%hfx_rho_ao_symm, work_matrices%hfx_hmat_symm, &
463 588 : work_matrices%hfx_rho_ao_asymm, work_matrices%hfx_hmat_asymm)
464 588 : IF (do_hfx) THEN
465 214 : IF (do_admm) THEN
466 124 : CALL get_qs_env(qs_env, dbcsr_dist=dbcsr_dist)
467 124 : CALL get_admm_env(qs_env%admm_env, sab_aux_fit=sab_hfx)
468 124 : dbcsr_template_hfx => matrix_s_aux_fit(1)%matrix
469 124 : IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
470 38 : CALL get_qs_env(qs_env, admm_env=admm_env, atomic_kind_set=atomic_kind_set)
471 38 : CALL local_rho_set_create(work_matrices%local_rho_set_admm)
472 : CALL allocate_rho_atom_internals(work_matrices%local_rho_set_admm%rho_atom_set, &
473 : atomic_kind_set, admm_env%admm_gapw_env%admm_kind_set, &
474 38 : dft_control, sub_env%para_env)
475 : END IF
476 : ELSE
477 90 : CALL get_qs_env(qs_env, dbcsr_dist=dbcsr_dist, sab_orb=sab_hfx)
478 90 : dbcsr_template_hfx => matrix_s(1)%matrix
479 : END IF
480 :
481 214 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
482 214 : ALLOCATE (work_matrices%hfx_fm_ao_ao)
483 214 : CALL cp_fm_create(work_matrices%hfx_fm_ao_ao, fm_struct)
484 214 : CALL cp_fm_struct_release(fm_struct)
485 :
486 214 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_rho_ao_symm, nspins)
487 214 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_rho_ao_asymm, nspins)
488 440 : DO ispin = 1, nspins
489 226 : CALL dbcsr_init_p(work_matrices%hfx_rho_ao_symm(ispin)%matrix)
490 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfx_rho_ao_symm(ispin)%matrix, &
491 226 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
492 :
493 226 : CALL dbcsr_init_p(work_matrices%hfx_rho_ao_asymm(ispin)%matrix)
494 : CALL dbcsr_create(work_matrices%hfx_rho_ao_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
495 226 : template=work_matrices%hfx_rho_ao_symm(ispin)%matrix)
496 : CALL dbcsr_complete_redistribute(work_matrices%hfx_rho_ao_symm(ispin)%matrix, &
497 440 : work_matrices%hfx_rho_ao_asymm(ispin)%matrix)
498 : END DO
499 :
500 214 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_hmat_symm, nspins)
501 214 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_hmat_asymm, nspins)
502 440 : DO ispin = 1, nspins
503 226 : CALL dbcsr_init_p(work_matrices%hfx_hmat_symm(ispin)%matrix)
504 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfx_hmat_symm(ispin)%matrix, &
505 226 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
506 :
507 226 : CALL dbcsr_init_p(work_matrices%hfx_hmat_asymm(ispin)%matrix)
508 : CALL dbcsr_create(work_matrices%hfx_hmat_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
509 226 : template=work_matrices%hfx_hmat_symm(ispin)%matrix)
510 : CALL dbcsr_complete_redistribute(work_matrices%hfx_hmat_symm(ispin)%matrix, &
511 440 : work_matrices%hfx_hmat_asymm(ispin)%matrix)
512 : END DO
513 : END IF
514 :
515 : ! matrices needed to do HFX short range calllculations
516 588 : NULLIFY (work_matrices%hfxsr_fm_ao_ao, work_matrices%hfxsr_rho_ao_symm, work_matrices%hfxsr_hmat_symm, &
517 588 : work_matrices%hfxsr_rho_ao_asymm, work_matrices%hfxsr_hmat_asymm)
518 : ! matrices needed to do HFX long range calllculations
519 588 : IF (do_hfxlr) THEN
520 12 : DO ispin = 1, nspins
521 : CALL cp_fm_struct_create(fm_struct_evects(ispin)%struct, nrow_global=nao, &
522 12 : ncol_global=nmo_occ(ispin), context=sub_env%blacs_env)
523 : END DO
524 6 : CALL dbcsr_init_p(work_matrices%shalf)
525 6 : CALL dbcsr_create(work_matrices%shalf, template=matrix_s(1)%matrix)
526 18 : ALLOCATE (work_matrices%ctransformed(nspins))
527 12 : DO ispin = 1, nspins
528 12 : CALL cp_fm_create(work_matrices%ctransformed(ispin), fm_struct_evects(ispin)%struct)
529 : END DO
530 : ! forces
531 18 : ALLOCATE (work_matrices%S_eigenvalues(nao))
532 6 : NULLIFY (fm_struct)
533 6 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
534 6 : ALLOCATE (work_matrices%S_eigenvectors, work_matrices%slambda)
535 6 : CALL cp_fm_create(work_matrices%S_eigenvectors, fm_struct)
536 6 : CALL cp_fm_create(work_matrices%slambda, fm_struct)
537 : !
538 6 : CALL cp_fm_struct_release(fm_struct)
539 12 : DO ispin = 1, nspins
540 12 : CALL cp_fm_struct_release(fm_struct_evects(ispin)%struct)
541 : END DO
542 : END IF
543 :
544 588 : CALL timestop(handle)
545 :
546 2352 : END SUBROUTINE tddfpt_create_work_matrices
547 :
548 : ! **************************************************************************************************
549 : !> \brief Allocate work matrices for hfxsr
550 : !> \param work_matrices work matrices (allocated on exit)
551 : !> \param qs_env ...
552 : !> \param admm_env ...
553 : ! **************************************************************************************************
554 12 : SUBROUTINE hfxsr_create_work_matrices(work_matrices, qs_env, admm_env)
555 : TYPE(tddfpt_work_matrices), INTENT(inout) :: work_matrices
556 : TYPE(qs_environment_type), POINTER :: qs_env
557 : TYPE(admm_type), POINTER :: admm_env
558 :
559 : CHARACTER(LEN=*), PARAMETER :: routineN = 'hfxsr_create_work_matrices'
560 :
561 : INTEGER :: handle, ispin, nao, nao_aux, nspins
562 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
563 : TYPE(cp_fm_struct_type), POINTER :: fm_struct
564 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
565 4 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, matrix_s_aux_fit
566 : TYPE(dbcsr_type), POINTER :: dbcsr_template_hfx
567 : TYPE(dft_control_type), POINTER :: dft_control
568 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
569 4 : POINTER :: sab_hfx
570 :
571 4 : CALL timeset(routineN, handle)
572 :
573 : ! matrices needed to do HFX short range calllculations
574 4 : NULLIFY (work_matrices%hfxsr_fm_ao_ao, work_matrices%hfxsr_rho_ao_symm, work_matrices%hfxsr_hmat_symm, &
575 4 : work_matrices%hfxsr_rho_ao_asymm, work_matrices%hfxsr_hmat_asymm)
576 :
577 : CALL get_qs_env(qs_env, dft_control=dft_control, matrix_s=matrix_s, &
578 4 : blacs_env=blacs_env, dbcsr_dist=dbcsr_dist)
579 4 : nspins = dft_control%nspins
580 4 : CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
581 4 : CALL get_admm_env(admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
582 4 : dbcsr_template_hfx => matrix_s_aux_fit(1)%matrix
583 4 : CALL dbcsr_get_info(dbcsr_template_hfx, nfullrows_total=nao_aux)
584 :
585 4 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
586 4 : ALLOCATE (work_matrices%hfxsr_fm_ao_ao)
587 4 : CALL cp_fm_create(work_matrices%hfxsr_fm_ao_ao, fm_struct)
588 4 : CALL cp_fm_struct_release(fm_struct)
589 :
590 4 : CALL get_admm_env(admm_env, sab_aux_fit=sab_hfx)
591 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_rho_ao_symm, nspins)
592 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_rho_ao_asymm, nspins)
593 8 : DO ispin = 1, nspins
594 4 : CALL dbcsr_init_p(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix)
595 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix, &
596 4 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
597 :
598 4 : CALL dbcsr_init_p(work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix)
599 : CALL dbcsr_create(work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
600 4 : template=work_matrices%hfxsr_rho_ao_symm(ispin)%matrix)
601 : CALL dbcsr_complete_redistribute(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix, &
602 8 : work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix)
603 : END DO
604 :
605 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_hmat_symm, nspins)
606 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_hmat_asymm, nspins)
607 8 : DO ispin = 1, nspins
608 4 : CALL dbcsr_init_p(work_matrices%hfxsr_hmat_symm(ispin)%matrix)
609 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfxsr_hmat_symm(ispin)%matrix, &
610 4 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
611 :
612 4 : CALL dbcsr_init_p(work_matrices%hfxsr_hmat_asymm(ispin)%matrix)
613 : CALL dbcsr_create(work_matrices%hfxsr_hmat_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
614 4 : template=work_matrices%hfxsr_hmat_symm(ispin)%matrix)
615 : CALL dbcsr_complete_redistribute(work_matrices%hfxsr_hmat_symm(ispin)%matrix, &
616 8 : work_matrices%hfxsr_hmat_asymm(ispin)%matrix)
617 : END DO
618 :
619 4 : CALL timestop(handle)
620 :
621 4 : END SUBROUTINE hfxsr_create_work_matrices
622 :
623 : ! **************************************************************************************************
624 : !> \brief Allocate work matrices for sTDA kernel
625 : !> \param work_matrices work matrices (allocated on exit)
626 : !> \param gs_mos occupied and virtual molecular orbitals optimised for the ground state
627 : !> \param nstates number of excited states to converge
628 : !> \param qs_env Quickstep environment
629 : !> \param sub_env parallel group environment
630 : !> \par History
631 : !> * 04.2019 created from full kernel version [JHU]
632 : ! **************************************************************************************************
633 992 : SUBROUTINE stda_create_work_matrices(work_matrices, gs_mos, nstates, qs_env, sub_env)
634 : TYPE(tddfpt_work_matrices), INTENT(out) :: work_matrices
635 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
636 : INTENT(in) :: gs_mos
637 : INTEGER, INTENT(in) :: nstates
638 : TYPE(qs_environment_type), POINTER :: qs_env
639 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
640 :
641 : CHARACTER(LEN=*), PARAMETER :: routineN = 'stda_create_work_matrices'
642 :
643 : INTEGER :: handle, igroup, ispin, istate, nao, &
644 : ngroups, nspins
645 : INTEGER, DIMENSION(maxspins) :: nmo_occ, nmo_virt
646 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
647 1488 : TYPE(cp_fm_struct_p_type), DIMENSION(maxspins) :: fm_struct_evects
648 : TYPE(cp_fm_struct_type), POINTER :: fm_struct
649 496 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
650 : TYPE(mp_para_env_type), POINTER :: para_env
651 :
652 496 : CALL timeset(routineN, handle)
653 :
654 496 : NULLIFY (work_matrices%gamma_exchange, work_matrices%ctransformed)
655 :
656 496 : nspins = SIZE(gs_mos)
657 496 : CALL get_qs_env(qs_env, blacs_env=blacs_env, matrix_s=matrix_s)
658 496 : CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
659 :
660 1024 : DO ispin = 1, nspins
661 528 : nmo_occ(ispin) = SIZE(gs_mos(ispin)%evals_occ)
662 496 : nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
663 : END DO
664 :
665 496 : NULLIFY (fm_struct)
666 2016 : ALLOCATE (work_matrices%fm_pool_ao_mo_occ(nspins))
667 1024 : DO ispin = 1, nspins
668 528 : NULLIFY (work_matrices%fm_pool_ao_mo_occ(ispin)%pool)
669 528 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nmo_occ(ispin), context=blacs_env)
670 528 : CALL fm_pool_create(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, fm_struct)
671 1024 : CALL cp_fm_struct_release(fm_struct)
672 : END DO
673 :
674 2016 : ALLOCATE (work_matrices%S_C0_C0T(nspins))
675 496 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
676 1024 : DO ispin = 1, nspins
677 1024 : CALL cp_fm_create(work_matrices%S_C0_C0T(ispin), fm_struct)
678 : END DO
679 496 : CALL cp_fm_struct_release(fm_struct)
680 :
681 1520 : ALLOCATE (work_matrices%S_C0(nspins))
682 1024 : DO ispin = 1, nspins
683 528 : CALL fm_pool_create_fm(work_matrices%fm_pool_ao_mo_occ(ispin)%pool, work_matrices%S_C0(ispin))
684 :
685 : CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, gs_mos(ispin)%mos_occ, work_matrices%S_C0(ispin), &
686 528 : ncol=nmo_occ(ispin), alpha=1.0_dp, beta=0.0_dp)
687 : CALL parallel_gemm('N', 'T', nao, nao, nmo_occ(ispin), 1.0_dp, work_matrices%S_C0(ispin), &
688 1024 : gs_mos(ispin)%mos_occ, 0.0_dp, work_matrices%S_C0_C0T(ispin))
689 : END DO
690 :
691 1024 : DO ispin = 1, nspins
692 : CALL cp_fm_struct_create(fm_struct_evects(ispin)%struct, nrow_global=nao, &
693 1024 : ncol_global=nmo_occ(ispin), context=sub_env%blacs_env)
694 : END DO
695 :
696 496 : IF (sub_env%is_split) THEN
697 0 : ALLOCATE (work_matrices%evects_sub(nspins, nstates), work_matrices%Aop_evects_sub(nspins, nstates))
698 :
699 0 : CALL blacs_env%get(para_env=para_env)
700 0 : igroup = sub_env%group_distribution(para_env%mepos)
701 0 : ngroups = sub_env%ngroups
702 :
703 0 : DO istate = ngroups - igroup, nstates, ngroups
704 0 : DO ispin = 1, nspins
705 0 : CALL cp_fm_create(work_matrices%evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
706 0 : CALL cp_fm_create(work_matrices%Aop_evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
707 : END DO
708 : END DO
709 : END IF
710 :
711 : ! sTDA specific work arrays
712 1520 : ALLOCATE (work_matrices%ctransformed(nspins))
713 1024 : DO ispin = 1, nspins
714 1024 : CALL cp_fm_create(work_matrices%ctransformed(ispin), fm_struct_evects(ispin)%struct)
715 : END DO
716 496 : NULLIFY (work_matrices%shalf)
717 496 : CALL dbcsr_init_p(work_matrices%shalf)
718 496 : CALL dbcsr_create(work_matrices%shalf, template=matrix_s(1)%matrix)
719 : ! forces
720 1488 : ALLOCATE (work_matrices%S_eigenvalues(nao))
721 496 : NULLIFY (fm_struct)
722 496 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
723 496 : ALLOCATE (work_matrices%S_eigenvectors, work_matrices%slambda)
724 496 : CALL cp_fm_create(work_matrices%S_eigenvectors, fm_struct)
725 496 : CALL cp_fm_create(work_matrices%slambda, fm_struct)
726 496 : CALL cp_fm_struct_release(fm_struct)
727 :
728 1024 : DO ispin = nspins, 1, -1
729 1024 : CALL cp_fm_struct_release(fm_struct_evects(ispin)%struct)
730 : END DO
731 :
732 496 : NULLIFY (work_matrices%rho_ao_orb_fm_sub)
733 496 : NULLIFY (work_matrices%rho_ao_aux_fit_fm_sub, work_matrices%wfm_aux_orb_sub)
734 496 : NULLIFY (work_matrices%rho_aux_fit_struct_sub)
735 496 : NULLIFY (work_matrices%rho_orb_struct_sub)
736 496 : NULLIFY (work_matrices%hfx_fm_ao_ao, work_matrices%hfx_rho_ao_symm, work_matrices%hfx_hmat_symm, &
737 496 : work_matrices%hfx_rho_ao_asymm, work_matrices%hfx_hmat_asymm)
738 496 : NULLIFY (work_matrices%hfxsr_fm_ao_ao, work_matrices%hfxsr_rho_ao_symm, work_matrices%hfxsr_hmat_symm, &
739 496 : work_matrices%hfxsr_rho_ao_asymm, work_matrices%hfxsr_hmat_asymm)
740 496 : NULLIFY (work_matrices%A_ia_rspace_sub, work_matrices%wpw_gspace_sub, &
741 496 : work_matrices%wpw_rspace_sub)
742 496 : NULLIFY (work_matrices%fxc_rspace_sub)
743 496 : NULLIFY (work_matrices%A_ia_munu_sub)
744 :
745 496 : NULLIFY (work_matrices%ewald_env)
746 496 : NULLIFY (work_matrices%ewald_pw)
747 :
748 496 : NULLIFY (work_matrices%hartree_local)
749 496 : NULLIFY (work_matrices%local_rho_set)
750 496 : NULLIFY (work_matrices%local_rho_set_admm)
751 496 : NULLIFY (work_matrices%rho_xc_struct_sub)
752 :
753 496 : CALL timestop(handle)
754 :
755 1488 : END SUBROUTINE stda_create_work_matrices
756 :
757 : ! **************************************************************************************************
758 : !> \brief Release work matrices.
759 : !> \param work_matrices work matrices (destroyed on exit)
760 : !> \param sub_env parallel group environment
761 : !> \par History
762 : !> * 02.2017 created [Sergey Chulkov]
763 : ! **************************************************************************************************
764 1084 : SUBROUTINE tddfpt_release_work_matrices(work_matrices, sub_env)
765 : TYPE(tddfpt_work_matrices), INTENT(inout) :: work_matrices
766 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
767 :
768 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_release_work_matrices'
769 :
770 : INTEGER :: handle, ispin
771 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
772 :
773 1084 : CALL timeset(routineN, handle)
774 :
775 : ! HFX-related matrices
776 1084 : IF (ASSOCIATED(work_matrices%hfx_hmat_symm)) THEN
777 440 : DO ispin = SIZE(work_matrices%hfx_hmat_symm), 1, -1
778 440 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_hmat_symm(ispin)%matrix)
779 : END DO
780 214 : DEALLOCATE (work_matrices%hfx_hmat_symm)
781 : END IF
782 :
783 1084 : IF (ASSOCIATED(work_matrices%hfx_hmat_asymm)) THEN
784 440 : DO ispin = SIZE(work_matrices%hfx_hmat_asymm), 1, -1
785 440 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_hmat_asymm(ispin)%matrix)
786 : END DO
787 214 : DEALLOCATE (work_matrices%hfx_hmat_asymm)
788 : END IF
789 :
790 1084 : IF (ASSOCIATED(work_matrices%hfx_rho_ao_symm)) THEN
791 440 : DO ispin = SIZE(work_matrices%hfx_rho_ao_symm), 1, -1
792 440 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_rho_ao_symm(ispin)%matrix)
793 : END DO
794 214 : DEALLOCATE (work_matrices%hfx_rho_ao_symm)
795 : END IF
796 :
797 1084 : IF (ASSOCIATED(work_matrices%hfx_rho_ao_asymm)) THEN
798 440 : DO ispin = SIZE(work_matrices%hfx_rho_ao_asymm), 1, -1
799 440 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_rho_ao_asymm(ispin)%matrix)
800 : END DO
801 214 : DEALLOCATE (work_matrices%hfx_rho_ao_asymm)
802 : END IF
803 :
804 1084 : IF (ASSOCIATED(work_matrices%hfx_fm_ao_ao)) THEN
805 214 : CALL cp_fm_release(work_matrices%hfx_fm_ao_ao)
806 214 : DEALLOCATE (work_matrices%hfx_fm_ao_ao)
807 : END IF
808 :
809 : ! HFXSR-related matrices
810 1084 : IF (ASSOCIATED(work_matrices%hfxsr_hmat_symm)) THEN
811 8 : DO ispin = SIZE(work_matrices%hfxsr_hmat_symm), 1, -1
812 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_hmat_symm(ispin)%matrix)
813 : END DO
814 4 : DEALLOCATE (work_matrices%hfxsr_hmat_symm)
815 : END IF
816 :
817 1084 : IF (ASSOCIATED(work_matrices%hfxsr_hmat_asymm)) THEN
818 8 : DO ispin = SIZE(work_matrices%hfxsr_hmat_asymm), 1, -1
819 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_hmat_asymm(ispin)%matrix)
820 : END DO
821 4 : DEALLOCATE (work_matrices%hfxsr_hmat_asymm)
822 : END IF
823 :
824 1084 : IF (ASSOCIATED(work_matrices%hfxsr_rho_ao_symm)) THEN
825 8 : DO ispin = SIZE(work_matrices%hfxsr_rho_ao_symm), 1, -1
826 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix)
827 : END DO
828 4 : DEALLOCATE (work_matrices%hfxsr_rho_ao_symm)
829 : END IF
830 :
831 1084 : IF (ASSOCIATED(work_matrices%hfxsr_rho_ao_asymm)) THEN
832 8 : DO ispin = SIZE(work_matrices%hfxsr_rho_ao_asymm), 1, -1
833 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix)
834 : END DO
835 4 : DEALLOCATE (work_matrices%hfxsr_rho_ao_asymm)
836 : END IF
837 :
838 1084 : IF (ASSOCIATED(work_matrices%hfxsr_fm_ao_ao)) THEN
839 4 : CALL cp_fm_release(work_matrices%hfxsr_fm_ao_ao)
840 4 : DEALLOCATE (work_matrices%hfxsr_fm_ao_ao)
841 : END IF
842 :
843 : ! real-space and reciprocal-space grids
844 1084 : IF (ASSOCIATED(sub_env%pw_env)) THEN
845 588 : CALL pw_env_get(sub_env%pw_env, auxbas_pw_pool=auxbas_pw_pool)
846 1268 : DO ispin = SIZE(work_matrices%wpw_rspace_sub), 1, -1
847 680 : CALL auxbas_pw_pool%give_back_pw(work_matrices%wpw_rspace_sub(ispin))
848 680 : CALL auxbas_pw_pool%give_back_pw(work_matrices%wpw_tau_rspace_sub(ispin))
849 680 : CALL auxbas_pw_pool%give_back_pw(work_matrices%wpw_gspace_sub(ispin))
850 1268 : CALL auxbas_pw_pool%give_back_pw(work_matrices%A_ia_rspace_sub(ispin))
851 : END DO
852 0 : DEALLOCATE (work_matrices%A_ia_rspace_sub, work_matrices%wpw_gspace_sub, &
853 588 : work_matrices%wpw_rspace_sub, work_matrices%wpw_tau_rspace_sub)
854 588 : IF (ASSOCIATED(work_matrices%fxc_rspace_sub)) THEN
855 48 : DO ispin = SIZE(work_matrices%fxc_rspace_sub), 1, -1
856 48 : CALL auxbas_pw_pool%give_back_pw(work_matrices%fxc_rspace_sub(ispin))
857 : END DO
858 12 : DEALLOCATE (work_matrices%fxc_rspace_sub)
859 : END IF
860 : END IF
861 :
862 1084 : IF (ASSOCIATED(work_matrices%rho_aux_fit_struct_sub)) THEN
863 124 : CALL qs_rho_release(work_matrices%rho_aux_fit_struct_sub)
864 124 : DEALLOCATE (work_matrices%rho_aux_fit_struct_sub)
865 : END IF
866 1084 : IF (ASSOCIATED(work_matrices%rho_orb_struct_sub)) THEN
867 588 : CALL qs_rho_release(work_matrices%rho_orb_struct_sub)
868 588 : DEALLOCATE (work_matrices%rho_orb_struct_sub)
869 : END IF
870 :
871 1084 : IF (ASSOCIATED(work_matrices%A_ia_munu_sub)) THEN
872 1268 : DO ispin = SIZE(work_matrices%A_ia_munu_sub), 1, -1
873 1268 : CALL dbcsr_deallocate_matrix(work_matrices%A_ia_munu_sub(ispin)%matrix)
874 : END DO
875 588 : DEALLOCATE (work_matrices%A_ia_munu_sub)
876 : END IF
877 :
878 1084 : IF (ASSOCIATED(work_matrices%wfm_aux_orb_sub)) THEN
879 124 : CALL cp_fm_release(work_matrices%wfm_aux_orb_sub)
880 124 : DEALLOCATE (work_matrices%wfm_aux_orb_sub)
881 : NULLIFY (work_matrices%wfm_aux_orb_sub)
882 : END IF
883 1084 : IF (ASSOCIATED(work_matrices%rho_ao_aux_fit_fm_sub)) THEN
884 124 : CALL cp_fm_release(work_matrices%rho_ao_aux_fit_fm_sub)
885 124 : DEALLOCATE (work_matrices%rho_ao_aux_fit_fm_sub)
886 : NULLIFY (work_matrices%rho_ao_aux_fit_fm_sub)
887 : END IF
888 1084 : IF (ASSOCIATED(work_matrices%rho_ao_orb_fm_sub)) THEN
889 588 : CALL cp_fm_release(work_matrices%rho_ao_orb_fm_sub)
890 588 : DEALLOCATE (work_matrices%rho_ao_orb_fm_sub)
891 : NULLIFY (work_matrices%rho_ao_orb_fm_sub)
892 : END IF
893 :
894 1084 : CALL cp_fm_release(work_matrices%Aop_evects_sub)
895 1084 : CALL cp_fm_release(work_matrices%evects_sub)
896 :
897 1084 : CALL cp_fm_release(work_matrices%S_C0)
898 1084 : CALL cp_fm_release(work_matrices%S_C0_C0T)
899 :
900 2292 : DO ispin = SIZE(work_matrices%fm_pool_ao_mo_occ), 1, -1
901 2292 : CALL fm_pool_release(work_matrices%fm_pool_ao_mo_occ(ispin)%pool)
902 : END DO
903 1084 : DEALLOCATE (work_matrices%fm_pool_ao_mo_occ)
904 :
905 : ! sTDA
906 1084 : IF (ASSOCIATED(work_matrices%gamma_exchange)) THEN
907 308 : CALL dbcsr_deallocate_matrix_set(work_matrices%gamma_exchange)
908 308 : NULLIFY (work_matrices%gamma_exchange)
909 : END IF
910 1084 : IF (ASSOCIATED(work_matrices%ctransformed)) THEN
911 502 : CALL cp_fm_release(work_matrices%ctransformed)
912 502 : NULLIFY (work_matrices%ctransformed)
913 : END IF
914 1084 : CALL dbcsr_release_p(work_matrices%shalf)
915 : !
916 1084 : IF (ASSOCIATED(work_matrices%S_eigenvectors)) THEN
917 502 : CALL cp_fm_release(work_matrices%S_eigenvectors)
918 502 : DEALLOCATE (work_matrices%S_eigenvectors)
919 : END IF
920 1084 : IF (ASSOCIATED(work_matrices%slambda)) THEN
921 502 : CALL cp_fm_release(work_matrices%slambda)
922 502 : DEALLOCATE (work_matrices%slambda)
923 : END IF
924 1084 : IF (ASSOCIATED(work_matrices%S_eigenvalues)) &
925 502 : DEALLOCATE (work_matrices%S_eigenvalues)
926 : ! Ewald
927 1084 : IF (ASSOCIATED(work_matrices%ewald_env)) THEN
928 94 : CALL ewald_env_release(work_matrices%ewald_env)
929 94 : DEALLOCATE (work_matrices%ewald_env)
930 : END IF
931 1084 : IF (ASSOCIATED(work_matrices%ewald_pw)) THEN
932 94 : CALL ewald_pw_release(work_matrices%ewald_pw)
933 94 : DEALLOCATE (work_matrices%ewald_pw)
934 : END IF
935 : ! GAPW
936 1084 : IF (ASSOCIATED(work_matrices%local_rho_set)) THEN
937 210 : CALL local_rho_set_release(work_matrices%local_rho_set)
938 : END IF
939 1084 : IF (ASSOCIATED(work_matrices%local_rho_set_admm)) THEN
940 38 : CALL local_rho_set_release(work_matrices%local_rho_set_admm)
941 : END IF
942 1084 : IF (ASSOCIATED(work_matrices%hartree_local)) THEN
943 174 : CALL hartree_local_release(work_matrices%hartree_local)
944 : END IF
945 : ! GAPW_XC
946 1084 : IF (ASSOCIATED(work_matrices%rho_xc_struct_sub)) THEN
947 36 : CALL qs_rho_release(work_matrices%rho_xc_struct_sub)
948 36 : DEALLOCATE (work_matrices%rho_xc_struct_sub)
949 : END IF
950 :
951 1084 : CALL timestop(handle)
952 :
953 1084 : END SUBROUTINE tddfpt_release_work_matrices
954 :
955 0 : END MODULE qs_tddfpt2_types
|
