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