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 : !> group-specific copy of a real-space grid for the kinetic energy density
171 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: wpw_tau_rspace_sub => NULL()
172 : !
173 : ! *** real space pw grid to hold fxc kernel <> A_ia_rspace_sub ***
174 : !
175 : TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: fxc_rspace_sub => NULL()
176 : !
177 : ! *** globally distributed matrices required to compute exact exchange terms ***
178 : !
179 : !> globally distributed version of the matrix 'rho_ao_orb_fm_sub' to store the electron density
180 : TYPE(cp_fm_type), POINTER :: hfx_fm_ao_ao => NULL()
181 : !> sparse matrix to store the electron density in terms of auxiliary (ADMM calculation)
182 : !> or primary (regular calculation) basis set
183 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfx_rho_ao_symm => NULL(), hfx_rho_ao_asymm => NULL()
184 : !> exact exchange expressed in terms of auxiliary or primary basis set
185 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfx_hmat_symm => NULL(), hfx_hmat_asymm => NULL()
186 : !> SR exact exchage matrices
187 : TYPE(cp_fm_type), POINTER :: hfxsr_fm_ao_ao => NULL()
188 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfxsr_rho_ao_symm => NULL(), hfxsr_rho_ao_asymm => NULL()
189 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: hfxsr_hmat_symm => NULL(), hfxsr_hmat_asymm => NULL()
190 : !
191 : ! *** matrices required for sTDA kernel, all matrices are within subgroups
192 : !
193 : ! Short-range gamma exchange matrix
194 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: gamma_exchange => NULL()
195 : !Lowdin MO coefficients: NAO*NOCC
196 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: ctransformed => NULL()
197 : !S^1/2
198 : TYPE(dbcsr_type), POINTER :: shalf => NULL()
199 : !Eigenvalues/eigenvectors of the overlap matrix, used in sTDA forces (Lowdin derivatives)
200 : REAL(KIND=dp), DIMENSION(:), POINTER :: S_eigenvalues => NULL()
201 : TYPE(cp_fm_type), POINTER :: S_eigenvectors => NULL()
202 : TYPE(cp_fm_type), POINTER :: slambda => NULL()
203 : !Ewald environments
204 : TYPE(ewald_environment_type), POINTER :: ewald_env => NULL()
205 : TYPE(ewald_pw_type), POINTER :: ewald_pw => NULL()
206 : !> GAPW local atomic grids
207 : TYPE(hartree_local_type), POINTER :: hartree_local => NULL()
208 : TYPE(local_rho_type), POINTER :: local_rho_set => NULL()
209 : TYPE(local_rho_type), POINTER :: local_rho_set_admm => NULL()
210 : END TYPE tddfpt_work_matrices
211 :
212 : CONTAINS
213 :
214 : ! **************************************************************************************************
215 : !> \brief Allocate work matrices for full kernel
216 : !> \param work_matrices work matrices (allocated on exit)
217 : !> \param gs_mos occupied and virtual molecular orbitals optimised for the ground state
218 : !> \param nstates number of excited states to converge
219 : !> \param do_hfx flag that requested to allocate work matrices required for computation
220 : !> of exact-exchange terms
221 : !> \param do_admm ...
222 : !> \param do_hfxlr ...
223 : !> \param do_exck ...
224 : !> \param do_sf ...
225 : !> \param qs_env Quickstep environment
226 : !> \param sub_env parallel group environment
227 : !> \par History
228 : !> * 02.2017 created [Sergey Chulkov]
229 : ! **************************************************************************************************
230 1640 : SUBROUTINE tddfpt_create_work_matrices(work_matrices, gs_mos, nstates, do_hfx, do_admm, &
231 : do_hfxlr, do_exck, do_sf, qs_env, sub_env)
232 : TYPE(tddfpt_work_matrices), INTENT(out) :: work_matrices
233 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
234 : INTENT(in) :: gs_mos
235 : INTEGER, INTENT(in) :: nstates
236 : LOGICAL, INTENT(in) :: do_hfx, do_admm, do_hfxlr, do_exck, do_sf
237 : TYPE(qs_environment_type), POINTER :: qs_env
238 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
239 :
240 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_create_work_matrices'
241 :
242 : INTEGER :: evecs_dim, handle, igroup, ispin, &
243 : istate, nao, nao_aux, natom, ngroups, &
244 : nspins
245 : INTEGER, DIMENSION(maxspins) :: nactive, nmo_occ, nmo_virt
246 : TYPE(admm_type), POINTER :: admm_env
247 820 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
248 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
249 2460 : TYPE(cp_fm_struct_p_type), DIMENSION(maxspins) :: fm_struct_evects
250 : TYPE(cp_fm_struct_type), POINTER :: fm_struct
251 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
252 820 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, matrix_s_aux_fit, rho_ia_ao, &
253 820 : rho_xc_ao
254 : TYPE(dbcsr_type), POINTER :: dbcsr_template_hfx
255 : TYPE(dft_control_type), POINTER :: dft_control
256 : TYPE(mp_para_env_type), POINTER :: para_env
257 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
258 820 : POINTER :: sab_hfx
259 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
260 820 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
261 :
262 820 : CALL timeset(routineN, handle)
263 :
264 : ! sTDA
265 820 : NULLIFY (work_matrices%shalf)
266 820 : NULLIFY (work_matrices%ewald_env)
267 820 : NULLIFY (work_matrices%ewald_pw)
268 820 : NULLIFY (work_matrices%gamma_exchange)
269 820 : NULLIFY (work_matrices%ctransformed)
270 820 : NULLIFY (work_matrices%S_eigenvalues)
271 820 : NULLIFY (work_matrices%S_eigenvectors)
272 820 : NULLIFY (work_matrices%slambda)
273 :
274 : ! GAPW
275 820 : NULLIFY (work_matrices%hartree_local)
276 820 : NULLIFY (work_matrices%local_rho_set)
277 820 : NULLIFY (work_matrices%local_rho_set_admm)
278 :
279 : ! EXCK
280 820 : NULLIFY (work_matrices%rho_xc_struct_sub)
281 :
282 820 : nspins = SIZE(gs_mos)
283 820 : IF (do_sf) THEN
284 22 : evecs_dim = 1
285 : ELSE
286 798 : evecs_dim = nspins
287 : END IF
288 820 : CALL get_qs_env(qs_env, blacs_env=blacs_env, matrix_s=matrix_s)
289 820 : CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
290 :
291 1760 : DO ispin = 1, nspins
292 940 : nactive(ispin) = gs_mos(ispin)%nmo_active
293 940 : nmo_occ(ispin) = gs_mos(ispin)%nmo_occ
294 820 : nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
295 : END DO
296 :
297 820 : IF (do_admm) THEN
298 168 : CPASSERT(do_hfx)
299 168 : CPASSERT(ASSOCIATED(sub_env%admm_A))
300 168 : CALL get_admm_env(qs_env%admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
301 168 : CALL dbcsr_get_info(matrix_s_aux_fit(1)%matrix, nfullrows_total=nao_aux)
302 : END IF
303 :
304 820 : NULLIFY (fm_struct)
305 3400 : ALLOCATE (work_matrices%fm_pool_ao_mo_active(nspins))
306 1760 : DO ispin = 1, nspins
307 940 : NULLIFY (work_matrices%fm_pool_ao_mo_active(ispin)%pool)
308 940 : CALL cp_fm_struct_create(fm_struct, template_fmstruct=gs_mos(ispin)%mos_active%matrix_struct, context=blacs_env)
309 940 : CALL fm_pool_create(work_matrices%fm_pool_ao_mo_active(ispin)%pool, fm_struct)
310 1760 : CALL cp_fm_struct_release(fm_struct)
311 : END DO
312 :
313 3400 : ALLOCATE (work_matrices%S_C0_C0T(nspins))
314 820 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
315 1760 : DO ispin = 1, nspins
316 1760 : CALL cp_fm_create(work_matrices%S_C0_C0T(ispin), fm_struct)
317 : END DO
318 820 : CALL cp_fm_struct_release(fm_struct)
319 :
320 2580 : ALLOCATE (work_matrices%S_C0(nspins))
321 1760 : DO ispin = 1, nspins
322 940 : CALL cp_fm_struct_create(fm_struct, template_fmstruct=gs_mos(ispin)%mos_occ%matrix_struct, context=blacs_env)
323 940 : CALL cp_fm_create(work_matrices%S_C0(ispin), fm_struct)
324 : CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, gs_mos(ispin)%mos_occ, work_matrices%S_C0(ispin), &
325 940 : ncol=nmo_occ(ispin), alpha=1.0_dp, beta=0.0_dp)
326 : CALL parallel_gemm('N', 'T', nao, nao, nmo_occ(ispin), 1.0_dp, work_matrices%S_C0(ispin), &
327 940 : gs_mos(ispin)%mos_occ, 0.0_dp, work_matrices%S_C0_C0T(ispin))
328 1760 : CALL cp_fm_struct_release(fm_struct)
329 : END DO
330 :
331 820 : IF (sub_env%is_split) THEN
332 4 : DO ispin = 1, evecs_dim
333 : CALL cp_fm_struct_create(fm_struct_evects(ispin)%struct, template_fmstruct=gs_mos(ispin)%mos_active%matrix_struct, &
334 4 : context=sub_env%blacs_env)
335 : END DO
336 :
337 28 : ALLOCATE (work_matrices%evects_sub(evecs_dim, nstates), work_matrices%Aop_evects_sub(evecs_dim, nstates))
338 :
339 2 : CALL blacs_env%get(para_env=para_env)
340 2 : igroup = sub_env%group_distribution(para_env%mepos)
341 2 : ngroups = sub_env%ngroups
342 :
343 4 : DO istate = ngroups - igroup, nstates, ngroups
344 6 : DO ispin = 1, evecs_dim
345 2 : CALL cp_fm_create(work_matrices%evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
346 4 : CALL cp_fm_create(work_matrices%Aop_evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
347 : END DO
348 : END DO
349 :
350 4 : DO ispin = evecs_dim, 1, -1
351 4 : CALL cp_fm_struct_release(fm_struct_evects(ispin)%struct)
352 : END DO
353 : END IF
354 :
355 820 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=sub_env%blacs_env)
356 820 : ALLOCATE (work_matrices%rho_ao_orb_fm_sub)
357 820 : CALL cp_fm_create(work_matrices%rho_ao_orb_fm_sub, fm_struct)
358 820 : CALL cp_fm_struct_release(fm_struct)
359 :
360 820 : NULLIFY (work_matrices%rho_ao_aux_fit_fm_sub, work_matrices%wfm_aux_orb_sub)
361 820 : IF (do_admm) THEN
362 168 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao_aux, ncol_global=nao_aux, context=sub_env%blacs_env)
363 168 : ALLOCATE (work_matrices%rho_ao_aux_fit_fm_sub)
364 168 : CALL cp_fm_create(work_matrices%rho_ao_aux_fit_fm_sub, fm_struct)
365 168 : CALL cp_fm_struct_release(fm_struct)
366 :
367 168 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao_aux, ncol_global=nao, context=sub_env%blacs_env)
368 168 : ALLOCATE (work_matrices%wfm_aux_orb_sub)
369 168 : CALL cp_fm_create(work_matrices%wfm_aux_orb_sub, fm_struct)
370 168 : CALL cp_fm_struct_release(fm_struct)
371 : END IF
372 :
373 : ! group-specific dbcsr matrices
374 820 : NULLIFY (work_matrices%A_ia_munu_sub)
375 820 : CALL dbcsr_allocate_matrix_set(work_matrices%A_ia_munu_sub, evecs_dim)
376 1738 : DO ispin = 1, evecs_dim
377 918 : CALL dbcsr_init_p(work_matrices%A_ia_munu_sub(ispin)%matrix)
378 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%A_ia_munu_sub(ispin)%matrix, template=matrix_s(1)%matrix, &
379 1738 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_orb)
380 : END DO
381 :
382 : ! group-specific response density
383 820 : NULLIFY (rho_ia_ao)
384 820 : CALL dbcsr_allocate_matrix_set(rho_ia_ao, nspins)
385 1760 : DO ispin = 1, nspins
386 940 : CALL dbcsr_init_p(rho_ia_ao(ispin)%matrix)
387 : CALL tddfpt_dbcsr_create_by_dist(rho_ia_ao(ispin)%matrix, template=matrix_s(1)%matrix, &
388 1760 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_orb)
389 : END DO
390 :
391 : NULLIFY (work_matrices%rho_orb_struct_sub)
392 820 : ALLOCATE (work_matrices%rho_orb_struct_sub)
393 820 : CALL qs_rho_create(work_matrices%rho_orb_struct_sub)
394 820 : CALL qs_rho_set(work_matrices%rho_orb_struct_sub, rho_ao=rho_ia_ao)
395 : CALL qs_rho_rebuild(work_matrices%rho_orb_struct_sub, qs_env, rebuild_ao=.FALSE., &
396 820 : rebuild_grids=.TRUE., pw_env_external=sub_env%pw_env)
397 820 : CALL get_qs_env(qs_env, dft_control=dft_control)
398 820 : IF (dft_control%qs_control%gapw_xc) THEN
399 72 : NULLIFY (rho_xc_ao)
400 72 : CALL dbcsr_allocate_matrix_set(rho_xc_ao, nspins)
401 144 : DO ispin = 1, nspins
402 72 : CALL dbcsr_init_p(rho_xc_ao(ispin)%matrix)
403 : CALL tddfpt_dbcsr_create_by_dist(rho_xc_ao(ispin)%matrix, template=matrix_s(1)%matrix, &
404 144 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_orb)
405 : END DO
406 : NULLIFY (work_matrices%rho_xc_struct_sub)
407 72 : ALLOCATE (work_matrices%rho_xc_struct_sub)
408 72 : CALL qs_rho_create(work_matrices%rho_xc_struct_sub)
409 72 : CALL qs_rho_set(work_matrices%rho_xc_struct_sub, rho_ao=rho_xc_ao)
410 : CALL qs_rho_rebuild(work_matrices%rho_xc_struct_sub, qs_env, rebuild_ao=.FALSE., &
411 72 : rebuild_grids=.TRUE., pw_env_external=sub_env%pw_env)
412 : END IF
413 :
414 820 : NULLIFY (work_matrices%rho_aux_fit_struct_sub)
415 820 : IF (do_admm) THEN
416 168 : NULLIFY (rho_ia_ao)
417 168 : CALL dbcsr_allocate_matrix_set(rho_ia_ao, nspins)
418 340 : DO ispin = 1, nspins
419 172 : CALL dbcsr_init_p(rho_ia_ao(ispin)%matrix)
420 : CALL tddfpt_dbcsr_create_by_dist(rho_ia_ao(ispin)%matrix, template=matrix_s_aux_fit(1)%matrix, &
421 340 : dbcsr_dist=sub_env%dbcsr_dist, sab=sub_env%sab_aux_fit)
422 : END DO
423 :
424 168 : ALLOCATE (work_matrices%rho_aux_fit_struct_sub)
425 168 : CALL qs_rho_create(work_matrices%rho_aux_fit_struct_sub)
426 168 : CALL qs_rho_set(work_matrices%rho_aux_fit_struct_sub, rho_ao=rho_ia_ao)
427 : CALL qs_rho_rebuild(work_matrices%rho_aux_fit_struct_sub, qs_env, rebuild_ao=.FALSE., &
428 168 : rebuild_grids=.TRUE., pw_env_external=sub_env%pw_env)
429 : END IF
430 :
431 : ! work plain-wave grids
432 820 : CALL pw_env_get(sub_env%pw_env, auxbas_pw_pool=auxbas_pw_pool)
433 3400 : ALLOCATE (work_matrices%A_ia_rspace_sub(nspins))
434 : ALLOCATE (work_matrices%wpw_gspace_sub(nspins), work_matrices%wpw_rspace_sub(nspins), &
435 6920 : work_matrices%wpw_tau_rspace_sub(nspins))
436 1760 : DO ispin = 1, nspins
437 940 : CALL auxbas_pw_pool%create_pw(work_matrices%A_ia_rspace_sub(ispin))
438 940 : CALL auxbas_pw_pool%create_pw(work_matrices%wpw_gspace_sub(ispin))
439 940 : CALL auxbas_pw_pool%create_pw(work_matrices%wpw_rspace_sub(ispin))
440 1760 : CALL auxbas_pw_pool%create_pw(work_matrices%wpw_tau_rspace_sub(ispin))
441 : END DO
442 :
443 : ! fxc kernel potential real space grid
444 820 : IF (do_exck) THEN
445 : ! we need spins: aa, ab, bb
446 48 : ALLOCATE (work_matrices%fxc_rspace_sub(3))
447 48 : DO ispin = 1, 3
448 48 : CALL auxbas_pw_pool%create_pw(work_matrices%fxc_rspace_sub(ispin))
449 : END DO
450 : ELSE
451 808 : NULLIFY (work_matrices%fxc_rspace_sub)
452 : END IF
453 :
454 : ! GAPW initializations
455 820 : IF (dft_control%qs_control%gapw) THEN
456 : CALL get_qs_env(qs_env, &
457 : atomic_kind_set=atomic_kind_set, &
458 : natom=natom, &
459 344 : qs_kind_set=qs_kind_set)
460 344 : CALL local_rho_set_create(work_matrices%local_rho_set)
461 : CALL allocate_rho_atom_internals(work_matrices%local_rho_set%rho_atom_set, atomic_kind_set, &
462 344 : qs_kind_set, dft_control, sub_env%para_env)
463 : CALL init_rho0(work_matrices%local_rho_set, qs_env, dft_control%qs_control%gapw_control, &
464 344 : zcore=0.0_dp)
465 344 : CALL rho0_s_grid_create(sub_env%pw_env, work_matrices%local_rho_set%rho0_mpole)
466 344 : CALL hartree_local_create(work_matrices%hartree_local)
467 344 : CALL init_coulomb_local(work_matrices%hartree_local, natom)
468 476 : ELSEIF (dft_control%qs_control%gapw_xc) THEN
469 : CALL get_qs_env(qs_env, &
470 : atomic_kind_set=atomic_kind_set, &
471 72 : qs_kind_set=qs_kind_set)
472 72 : CALL local_rho_set_create(work_matrices%local_rho_set)
473 : CALL allocate_rho_atom_internals(work_matrices%local_rho_set%rho_atom_set, atomic_kind_set, &
474 72 : qs_kind_set, dft_control, sub_env%para_env)
475 : END IF
476 :
477 : ! HFX-related globally distributed matrices
478 820 : NULLIFY (work_matrices%hfx_fm_ao_ao, work_matrices%hfx_rho_ao_symm, work_matrices%hfx_hmat_symm, &
479 820 : work_matrices%hfx_rho_ao_asymm, work_matrices%hfx_hmat_asymm)
480 820 : IF (do_hfx) THEN
481 290 : IF (do_admm) THEN
482 168 : CALL get_qs_env(qs_env, dbcsr_dist=dbcsr_dist)
483 168 : CALL get_admm_env(qs_env%admm_env, sab_aux_fit=sab_hfx)
484 168 : dbcsr_template_hfx => matrix_s_aux_fit(1)%matrix
485 168 : IF (dft_control%qs_control%gapw .OR. dft_control%qs_control%gapw_xc) THEN
486 80 : CALL get_qs_env(qs_env, admm_env=admm_env, atomic_kind_set=atomic_kind_set)
487 80 : CALL local_rho_set_create(work_matrices%local_rho_set_admm)
488 : CALL allocate_rho_atom_internals(work_matrices%local_rho_set_admm%rho_atom_set, &
489 : atomic_kind_set, admm_env%admm_gapw_env%admm_kind_set, &
490 80 : dft_control, sub_env%para_env)
491 : END IF
492 : ELSE
493 122 : CALL get_qs_env(qs_env, dbcsr_dist=dbcsr_dist, sab_orb=sab_hfx)
494 122 : dbcsr_template_hfx => matrix_s(1)%matrix
495 : END IF
496 :
497 290 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
498 290 : ALLOCATE (work_matrices%hfx_fm_ao_ao)
499 290 : CALL cp_fm_create(work_matrices%hfx_fm_ao_ao, fm_struct)
500 290 : CALL cp_fm_struct_release(fm_struct)
501 :
502 290 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_rho_ao_symm, nspins)
503 290 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_rho_ao_asymm, nspins)
504 596 : DO ispin = 1, nspins
505 306 : CALL dbcsr_init_p(work_matrices%hfx_rho_ao_symm(ispin)%matrix)
506 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfx_rho_ao_symm(ispin)%matrix, &
507 306 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
508 :
509 306 : CALL dbcsr_init_p(work_matrices%hfx_rho_ao_asymm(ispin)%matrix)
510 : CALL dbcsr_create(work_matrices%hfx_rho_ao_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
511 306 : template=work_matrices%hfx_rho_ao_symm(ispin)%matrix)
512 : CALL dbcsr_complete_redistribute(work_matrices%hfx_rho_ao_symm(ispin)%matrix, &
513 596 : work_matrices%hfx_rho_ao_asymm(ispin)%matrix)
514 : END DO
515 :
516 290 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_hmat_symm, nspins)
517 290 : CALL dbcsr_allocate_matrix_set(work_matrices%hfx_hmat_asymm, nspins)
518 596 : DO ispin = 1, nspins
519 306 : CALL dbcsr_init_p(work_matrices%hfx_hmat_symm(ispin)%matrix)
520 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfx_hmat_symm(ispin)%matrix, &
521 306 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
522 :
523 306 : CALL dbcsr_init_p(work_matrices%hfx_hmat_asymm(ispin)%matrix)
524 : CALL dbcsr_create(work_matrices%hfx_hmat_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
525 306 : template=work_matrices%hfx_hmat_symm(ispin)%matrix)
526 : CALL dbcsr_complete_redistribute(work_matrices%hfx_hmat_symm(ispin)%matrix, &
527 596 : work_matrices%hfx_hmat_asymm(ispin)%matrix)
528 : END DO
529 : END IF
530 :
531 : ! matrices needed to do HFX short range calllculations
532 820 : NULLIFY (work_matrices%hfxsr_fm_ao_ao, work_matrices%hfxsr_rho_ao_symm, work_matrices%hfxsr_hmat_symm, &
533 820 : work_matrices%hfxsr_rho_ao_asymm, work_matrices%hfxsr_hmat_asymm)
534 : ! matrices needed to do HFX long range calllculations
535 820 : IF (do_hfxlr) THEN
536 12 : DO ispin = 1, nspins
537 : CALL cp_fm_struct_create(fm_struct_evects(ispin)%struct, template_fmstruct=gs_mos(ispin)%mos_active%matrix_struct, &
538 12 : context=sub_env%blacs_env)
539 : END DO
540 6 : CALL dbcsr_init_p(work_matrices%shalf)
541 6 : CALL dbcsr_create(work_matrices%shalf, template=matrix_s(1)%matrix)
542 18 : ALLOCATE (work_matrices%ctransformed(nspins))
543 12 : DO ispin = 1, nspins
544 12 : CALL cp_fm_create(work_matrices%ctransformed(ispin), fm_struct_evects(ispin)%struct)
545 : END DO
546 : ! forces
547 18 : ALLOCATE (work_matrices%S_eigenvalues(nao))
548 6 : NULLIFY (fm_struct)
549 6 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
550 6 : ALLOCATE (work_matrices%S_eigenvectors, work_matrices%slambda)
551 6 : CALL cp_fm_create(work_matrices%S_eigenvectors, fm_struct)
552 6 : CALL cp_fm_create(work_matrices%slambda, fm_struct)
553 : !
554 6 : CALL cp_fm_struct_release(fm_struct)
555 12 : DO ispin = 1, nspins
556 12 : CALL cp_fm_struct_release(fm_struct_evects(ispin)%struct)
557 : END DO
558 : END IF
559 :
560 820 : CALL timestop(handle)
561 :
562 3280 : END SUBROUTINE tddfpt_create_work_matrices
563 :
564 : ! **************************************************************************************************
565 : !> \brief Allocate work matrices for hfxsr
566 : !> \param work_matrices work matrices (allocated on exit)
567 : !> \param qs_env ...
568 : !> \param admm_env ...
569 : ! **************************************************************************************************
570 12 : SUBROUTINE hfxsr_create_work_matrices(work_matrices, qs_env, admm_env)
571 : TYPE(tddfpt_work_matrices), INTENT(inout) :: work_matrices
572 : TYPE(qs_environment_type), POINTER :: qs_env
573 : TYPE(admm_type), POINTER :: admm_env
574 :
575 : CHARACTER(LEN=*), PARAMETER :: routineN = 'hfxsr_create_work_matrices'
576 :
577 : INTEGER :: handle, ispin, nao, nao_aux, nspins
578 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
579 : TYPE(cp_fm_struct_type), POINTER :: fm_struct
580 : TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
581 4 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, matrix_s_aux_fit
582 : TYPE(dbcsr_type), POINTER :: dbcsr_template_hfx
583 : TYPE(dft_control_type), POINTER :: dft_control
584 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
585 4 : POINTER :: sab_hfx
586 :
587 4 : CALL timeset(routineN, handle)
588 :
589 : ! matrices needed to do HFX short range calllculations
590 4 : NULLIFY (work_matrices%hfxsr_fm_ao_ao, work_matrices%hfxsr_rho_ao_symm, work_matrices%hfxsr_hmat_symm, &
591 4 : work_matrices%hfxsr_rho_ao_asymm, work_matrices%hfxsr_hmat_asymm)
592 :
593 : CALL get_qs_env(qs_env, dft_control=dft_control, matrix_s=matrix_s, &
594 4 : blacs_env=blacs_env, dbcsr_dist=dbcsr_dist)
595 4 : nspins = dft_control%nspins
596 4 : CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
597 4 : CALL get_admm_env(admm_env, matrix_s_aux_fit=matrix_s_aux_fit)
598 4 : dbcsr_template_hfx => matrix_s_aux_fit(1)%matrix
599 4 : CALL dbcsr_get_info(dbcsr_template_hfx, nfullrows_total=nao_aux)
600 :
601 4 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
602 4 : ALLOCATE (work_matrices%hfxsr_fm_ao_ao)
603 4 : CALL cp_fm_create(work_matrices%hfxsr_fm_ao_ao, fm_struct)
604 4 : CALL cp_fm_struct_release(fm_struct)
605 :
606 4 : CALL get_admm_env(admm_env, sab_aux_fit=sab_hfx)
607 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_rho_ao_symm, nspins)
608 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_rho_ao_asymm, nspins)
609 8 : DO ispin = 1, nspins
610 4 : CALL dbcsr_init_p(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix)
611 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix, &
612 4 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
613 :
614 4 : CALL dbcsr_init_p(work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix)
615 : CALL dbcsr_create(work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
616 4 : template=work_matrices%hfxsr_rho_ao_symm(ispin)%matrix)
617 : CALL dbcsr_complete_redistribute(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix, &
618 8 : work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix)
619 : END DO
620 :
621 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_hmat_symm, nspins)
622 4 : CALL dbcsr_allocate_matrix_set(work_matrices%hfxsr_hmat_asymm, nspins)
623 8 : DO ispin = 1, nspins
624 4 : CALL dbcsr_init_p(work_matrices%hfxsr_hmat_symm(ispin)%matrix)
625 : CALL tddfpt_dbcsr_create_by_dist(work_matrices%hfxsr_hmat_symm(ispin)%matrix, &
626 4 : template=dbcsr_template_hfx, dbcsr_dist=dbcsr_dist, sab=sab_hfx)
627 :
628 4 : CALL dbcsr_init_p(work_matrices%hfxsr_hmat_asymm(ispin)%matrix)
629 : CALL dbcsr_create(work_matrices%hfxsr_hmat_asymm(ispin)%matrix, matrix_type=dbcsr_type_antisymmetric, &
630 4 : template=work_matrices%hfxsr_hmat_symm(ispin)%matrix)
631 : CALL dbcsr_complete_redistribute(work_matrices%hfxsr_hmat_symm(ispin)%matrix, &
632 8 : work_matrices%hfxsr_hmat_asymm(ispin)%matrix)
633 : END DO
634 :
635 4 : CALL timestop(handle)
636 :
637 4 : END SUBROUTINE hfxsr_create_work_matrices
638 :
639 : ! **************************************************************************************************
640 : !> \brief Allocate work matrices for sTDA kernel
641 : !> \param work_matrices work matrices (allocated on exit)
642 : !> \param gs_mos occupied and virtual molecular orbitals optimised for the ground state
643 : !> \param nstates number of excited states to converge
644 : !> \param qs_env Quickstep environment
645 : !> \param sub_env parallel group environment
646 : !> \par History
647 : !> * 04.2019 created from full kernel version [JHU]
648 : ! **************************************************************************************************
649 1064 : SUBROUTINE stda_create_work_matrices(work_matrices, gs_mos, nstates, qs_env, sub_env)
650 : TYPE(tddfpt_work_matrices), INTENT(out) :: work_matrices
651 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
652 : INTENT(in) :: gs_mos
653 : INTEGER, INTENT(in) :: nstates
654 : TYPE(qs_environment_type), POINTER :: qs_env
655 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
656 :
657 : CHARACTER(LEN=*), PARAMETER :: routineN = 'stda_create_work_matrices'
658 :
659 : INTEGER :: handle, igroup, ispin, istate, nao, &
660 : ngroups, nspins
661 : INTEGER, DIMENSION(maxspins) :: nactive, nmo_occ, nmo_virt
662 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
663 1596 : TYPE(cp_fm_struct_p_type), DIMENSION(maxspins) :: fm_struct_evects
664 : TYPE(cp_fm_struct_type), POINTER :: fm_struct
665 532 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
666 : TYPE(mp_para_env_type), POINTER :: para_env
667 :
668 532 : CALL timeset(routineN, handle)
669 :
670 532 : NULLIFY (work_matrices%gamma_exchange, work_matrices%ctransformed)
671 :
672 532 : nspins = SIZE(gs_mos)
673 532 : CALL get_qs_env(qs_env, blacs_env=blacs_env, matrix_s=matrix_s)
674 532 : CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
675 :
676 1096 : DO ispin = 1, nspins
677 564 : nactive(ispin) = gs_mos(ispin)%nmo_active
678 564 : nmo_occ(ispin) = gs_mos(ispin)%nmo_occ
679 532 : nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
680 : END DO
681 :
682 532 : NULLIFY (fm_struct)
683 2160 : ALLOCATE (work_matrices%fm_pool_ao_mo_active(nspins))
684 1096 : DO ispin = 1, nspins
685 564 : NULLIFY (work_matrices%fm_pool_ao_mo_active(ispin)%pool)
686 564 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nactive(ispin), context=blacs_env)
687 564 : CALL fm_pool_create(work_matrices%fm_pool_ao_mo_active(ispin)%pool, fm_struct)
688 1096 : CALL cp_fm_struct_release(fm_struct)
689 : END DO
690 :
691 2160 : ALLOCATE (work_matrices%S_C0_C0T(nspins))
692 532 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
693 1096 : DO ispin = 1, nspins
694 1096 : CALL cp_fm_create(work_matrices%S_C0_C0T(ispin), fm_struct)
695 : END DO
696 532 : CALL cp_fm_struct_release(fm_struct)
697 :
698 1628 : ALLOCATE (work_matrices%S_C0(nspins))
699 1096 : DO ispin = 1, nspins
700 564 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nmo_occ(ispin), context=blacs_env)
701 564 : CALL cp_fm_create(work_matrices%S_C0(ispin), fm_struct)
702 : CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, gs_mos(ispin)%mos_occ, work_matrices%S_C0(ispin), &
703 564 : ncol=nmo_occ(ispin), alpha=1.0_dp, beta=0.0_dp)
704 : CALL parallel_gemm('N', 'T', nao, nao, nmo_occ(ispin), 1.0_dp, work_matrices%S_C0(ispin), &
705 564 : gs_mos(ispin)%mos_occ, 0.0_dp, work_matrices%S_C0_C0T(ispin))
706 1096 : CALL cp_fm_struct_release(fm_struct)
707 : END DO
708 :
709 1096 : DO ispin = 1, nspins
710 : CALL cp_fm_struct_create(fm_struct_evects(ispin)%struct, nrow_global=nao, &
711 1096 : ncol_global=nactive(ispin), context=sub_env%blacs_env)
712 : END DO
713 :
714 532 : IF (sub_env%is_split) THEN
715 0 : ALLOCATE (work_matrices%evects_sub(nspins, nstates), work_matrices%Aop_evects_sub(nspins, nstates))
716 :
717 0 : CALL blacs_env%get(para_env=para_env)
718 0 : igroup = sub_env%group_distribution(para_env%mepos)
719 0 : ngroups = sub_env%ngroups
720 :
721 0 : DO istate = ngroups - igroup, nstates, ngroups
722 0 : DO ispin = 1, nspins
723 0 : CALL cp_fm_create(work_matrices%evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
724 0 : CALL cp_fm_create(work_matrices%Aop_evects_sub(ispin, istate), fm_struct_evects(ispin)%struct)
725 : END DO
726 : END DO
727 : END IF
728 :
729 : ! sTDA specific work arrays
730 1628 : ALLOCATE (work_matrices%ctransformed(nspins))
731 1096 : DO ispin = 1, nspins
732 1096 : CALL cp_fm_create(work_matrices%ctransformed(ispin), fm_struct_evects(ispin)%struct)
733 : END DO
734 532 : NULLIFY (work_matrices%shalf)
735 532 : CALL dbcsr_init_p(work_matrices%shalf)
736 532 : CALL dbcsr_create(work_matrices%shalf, template=matrix_s(1)%matrix)
737 : ! forces
738 1596 : ALLOCATE (work_matrices%S_eigenvalues(nao))
739 532 : NULLIFY (fm_struct)
740 532 : CALL cp_fm_struct_create(fm_struct, nrow_global=nao, ncol_global=nao, context=blacs_env)
741 532 : ALLOCATE (work_matrices%S_eigenvectors, work_matrices%slambda)
742 532 : CALL cp_fm_create(work_matrices%S_eigenvectors, fm_struct)
743 532 : CALL cp_fm_create(work_matrices%slambda, fm_struct)
744 532 : CALL cp_fm_struct_release(fm_struct)
745 :
746 1096 : DO ispin = nspins, 1, -1
747 1096 : CALL cp_fm_struct_release(fm_struct_evects(ispin)%struct)
748 : END DO
749 :
750 532 : NULLIFY (work_matrices%rho_ao_orb_fm_sub)
751 532 : NULLIFY (work_matrices%rho_ao_aux_fit_fm_sub, work_matrices%wfm_aux_orb_sub)
752 532 : NULLIFY (work_matrices%rho_aux_fit_struct_sub)
753 532 : NULLIFY (work_matrices%rho_orb_struct_sub)
754 532 : NULLIFY (work_matrices%hfx_fm_ao_ao, work_matrices%hfx_rho_ao_symm, work_matrices%hfx_hmat_symm, &
755 532 : work_matrices%hfx_rho_ao_asymm, work_matrices%hfx_hmat_asymm)
756 532 : NULLIFY (work_matrices%hfxsr_fm_ao_ao, work_matrices%hfxsr_rho_ao_symm, work_matrices%hfxsr_hmat_symm, &
757 532 : work_matrices%hfxsr_rho_ao_asymm, work_matrices%hfxsr_hmat_asymm)
758 532 : NULLIFY (work_matrices%A_ia_rspace_sub, work_matrices%wpw_gspace_sub, &
759 532 : work_matrices%wpw_rspace_sub)
760 532 : NULLIFY (work_matrices%fxc_rspace_sub)
761 532 : NULLIFY (work_matrices%A_ia_munu_sub)
762 :
763 532 : NULLIFY (work_matrices%ewald_env)
764 532 : NULLIFY (work_matrices%ewald_pw)
765 :
766 532 : NULLIFY (work_matrices%hartree_local)
767 532 : NULLIFY (work_matrices%local_rho_set)
768 532 : NULLIFY (work_matrices%local_rho_set_admm)
769 532 : NULLIFY (work_matrices%rho_xc_struct_sub)
770 :
771 532 : CALL timestop(handle)
772 :
773 1596 : END SUBROUTINE stda_create_work_matrices
774 :
775 : ! **************************************************************************************************
776 : !> \brief Release work matrices.
777 : !> \param work_matrices work matrices (destroyed on exit)
778 : !> \param sub_env parallel group environment
779 : !> \par History
780 : !> * 02.2017 created [Sergey Chulkov]
781 : ! **************************************************************************************************
782 1352 : SUBROUTINE tddfpt_release_work_matrices(work_matrices, sub_env)
783 : TYPE(tddfpt_work_matrices), INTENT(inout) :: work_matrices
784 : TYPE(tddfpt_subgroup_env_type), INTENT(in) :: sub_env
785 :
786 : CHARACTER(LEN=*), PARAMETER :: routineN = 'tddfpt_release_work_matrices'
787 :
788 : INTEGER :: handle, ispin
789 : TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
790 :
791 1352 : CALL timeset(routineN, handle)
792 :
793 : ! HFX-related matrices
794 1352 : IF (ASSOCIATED(work_matrices%hfx_hmat_symm)) THEN
795 596 : DO ispin = SIZE(work_matrices%hfx_hmat_symm), 1, -1
796 596 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_hmat_symm(ispin)%matrix)
797 : END DO
798 290 : DEALLOCATE (work_matrices%hfx_hmat_symm)
799 : END IF
800 :
801 1352 : IF (ASSOCIATED(work_matrices%hfx_hmat_asymm)) THEN
802 596 : DO ispin = SIZE(work_matrices%hfx_hmat_asymm), 1, -1
803 596 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_hmat_asymm(ispin)%matrix)
804 : END DO
805 290 : DEALLOCATE (work_matrices%hfx_hmat_asymm)
806 : END IF
807 :
808 1352 : IF (ASSOCIATED(work_matrices%hfx_rho_ao_symm)) THEN
809 596 : DO ispin = SIZE(work_matrices%hfx_rho_ao_symm), 1, -1
810 596 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_rho_ao_symm(ispin)%matrix)
811 : END DO
812 290 : DEALLOCATE (work_matrices%hfx_rho_ao_symm)
813 : END IF
814 :
815 1352 : IF (ASSOCIATED(work_matrices%hfx_rho_ao_asymm)) THEN
816 596 : DO ispin = SIZE(work_matrices%hfx_rho_ao_asymm), 1, -1
817 596 : CALL dbcsr_deallocate_matrix(work_matrices%hfx_rho_ao_asymm(ispin)%matrix)
818 : END DO
819 290 : DEALLOCATE (work_matrices%hfx_rho_ao_asymm)
820 : END IF
821 :
822 1352 : IF (ASSOCIATED(work_matrices%hfx_fm_ao_ao)) THEN
823 290 : CALL cp_fm_release(work_matrices%hfx_fm_ao_ao)
824 290 : DEALLOCATE (work_matrices%hfx_fm_ao_ao)
825 : END IF
826 :
827 : ! HFXSR-related matrices
828 1352 : IF (ASSOCIATED(work_matrices%hfxsr_hmat_symm)) THEN
829 8 : DO ispin = SIZE(work_matrices%hfxsr_hmat_symm), 1, -1
830 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_hmat_symm(ispin)%matrix)
831 : END DO
832 4 : DEALLOCATE (work_matrices%hfxsr_hmat_symm)
833 : END IF
834 :
835 1352 : IF (ASSOCIATED(work_matrices%hfxsr_hmat_asymm)) THEN
836 8 : DO ispin = SIZE(work_matrices%hfxsr_hmat_asymm), 1, -1
837 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_hmat_asymm(ispin)%matrix)
838 : END DO
839 4 : DEALLOCATE (work_matrices%hfxsr_hmat_asymm)
840 : END IF
841 :
842 1352 : IF (ASSOCIATED(work_matrices%hfxsr_rho_ao_symm)) THEN
843 8 : DO ispin = SIZE(work_matrices%hfxsr_rho_ao_symm), 1, -1
844 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_rho_ao_symm(ispin)%matrix)
845 : END DO
846 4 : DEALLOCATE (work_matrices%hfxsr_rho_ao_symm)
847 : END IF
848 :
849 1352 : IF (ASSOCIATED(work_matrices%hfxsr_rho_ao_asymm)) THEN
850 8 : DO ispin = SIZE(work_matrices%hfxsr_rho_ao_asymm), 1, -1
851 8 : CALL dbcsr_deallocate_matrix(work_matrices%hfxsr_rho_ao_asymm(ispin)%matrix)
852 : END DO
853 4 : DEALLOCATE (work_matrices%hfxsr_rho_ao_asymm)
854 : END IF
855 :
856 1352 : IF (ASSOCIATED(work_matrices%hfxsr_fm_ao_ao)) THEN
857 4 : CALL cp_fm_release(work_matrices%hfxsr_fm_ao_ao)
858 4 : DEALLOCATE (work_matrices%hfxsr_fm_ao_ao)
859 : END IF
860 :
861 : ! real-space and reciprocal-space grids
862 1352 : IF (ASSOCIATED(sub_env%pw_env)) THEN
863 820 : CALL pw_env_get(sub_env%pw_env, auxbas_pw_pool=auxbas_pw_pool)
864 1760 : DO ispin = SIZE(work_matrices%wpw_rspace_sub), 1, -1
865 940 : CALL auxbas_pw_pool%give_back_pw(work_matrices%wpw_rspace_sub(ispin))
866 940 : CALL auxbas_pw_pool%give_back_pw(work_matrices%wpw_tau_rspace_sub(ispin))
867 940 : CALL auxbas_pw_pool%give_back_pw(work_matrices%wpw_gspace_sub(ispin))
868 1760 : CALL auxbas_pw_pool%give_back_pw(work_matrices%A_ia_rspace_sub(ispin))
869 : END DO
870 0 : DEALLOCATE (work_matrices%A_ia_rspace_sub, work_matrices%wpw_gspace_sub, &
871 820 : work_matrices%wpw_rspace_sub, work_matrices%wpw_tau_rspace_sub)
872 820 : IF (ASSOCIATED(work_matrices%fxc_rspace_sub)) THEN
873 48 : DO ispin = SIZE(work_matrices%fxc_rspace_sub), 1, -1
874 48 : CALL auxbas_pw_pool%give_back_pw(work_matrices%fxc_rspace_sub(ispin))
875 : END DO
876 12 : DEALLOCATE (work_matrices%fxc_rspace_sub)
877 : END IF
878 : END IF
879 :
880 1352 : IF (ASSOCIATED(work_matrices%rho_aux_fit_struct_sub)) THEN
881 168 : CALL qs_rho_release(work_matrices%rho_aux_fit_struct_sub)
882 168 : DEALLOCATE (work_matrices%rho_aux_fit_struct_sub)
883 : END IF
884 1352 : IF (ASSOCIATED(work_matrices%rho_orb_struct_sub)) THEN
885 820 : CALL qs_rho_release(work_matrices%rho_orb_struct_sub)
886 820 : DEALLOCATE (work_matrices%rho_orb_struct_sub)
887 : END IF
888 :
889 1352 : IF (ASSOCIATED(work_matrices%A_ia_munu_sub)) THEN
890 1738 : DO ispin = SIZE(work_matrices%A_ia_munu_sub), 1, -1
891 1738 : CALL dbcsr_deallocate_matrix(work_matrices%A_ia_munu_sub(ispin)%matrix)
892 : END DO
893 820 : DEALLOCATE (work_matrices%A_ia_munu_sub)
894 : END IF
895 :
896 1352 : IF (ASSOCIATED(work_matrices%wfm_aux_orb_sub)) THEN
897 168 : CALL cp_fm_release(work_matrices%wfm_aux_orb_sub)
898 168 : DEALLOCATE (work_matrices%wfm_aux_orb_sub)
899 : NULLIFY (work_matrices%wfm_aux_orb_sub)
900 : END IF
901 1352 : IF (ASSOCIATED(work_matrices%rho_ao_aux_fit_fm_sub)) THEN
902 168 : CALL cp_fm_release(work_matrices%rho_ao_aux_fit_fm_sub)
903 168 : DEALLOCATE (work_matrices%rho_ao_aux_fit_fm_sub)
904 : NULLIFY (work_matrices%rho_ao_aux_fit_fm_sub)
905 : END IF
906 1352 : IF (ASSOCIATED(work_matrices%rho_ao_orb_fm_sub)) THEN
907 820 : CALL cp_fm_release(work_matrices%rho_ao_orb_fm_sub)
908 820 : DEALLOCATE (work_matrices%rho_ao_orb_fm_sub)
909 : NULLIFY (work_matrices%rho_ao_orb_fm_sub)
910 : END IF
911 :
912 1352 : CALL cp_fm_release(work_matrices%Aop_evects_sub)
913 1352 : CALL cp_fm_release(work_matrices%evects_sub)
914 :
915 1352 : CALL cp_fm_release(work_matrices%S_C0)
916 1352 : CALL cp_fm_release(work_matrices%S_C0_C0T)
917 :
918 2856 : DO ispin = SIZE(work_matrices%fm_pool_ao_mo_active), 1, -1
919 2856 : CALL fm_pool_release(work_matrices%fm_pool_ao_mo_active(ispin)%pool)
920 : END DO
921 1352 : DEALLOCATE (work_matrices%fm_pool_ao_mo_active)
922 :
923 : ! sTDA
924 1352 : IF (ASSOCIATED(work_matrices%gamma_exchange)) THEN
925 314 : CALL dbcsr_deallocate_matrix_set(work_matrices%gamma_exchange)
926 314 : NULLIFY (work_matrices%gamma_exchange)
927 : END IF
928 1352 : IF (ASSOCIATED(work_matrices%ctransformed)) THEN
929 538 : CALL cp_fm_release(work_matrices%ctransformed)
930 538 : NULLIFY (work_matrices%ctransformed)
931 : END IF
932 1352 : CALL dbcsr_release_p(work_matrices%shalf)
933 : !
934 1352 : IF (ASSOCIATED(work_matrices%S_eigenvectors)) THEN
935 538 : CALL cp_fm_release(work_matrices%S_eigenvectors)
936 538 : DEALLOCATE (work_matrices%S_eigenvectors)
937 : END IF
938 1352 : IF (ASSOCIATED(work_matrices%slambda)) THEN
939 538 : CALL cp_fm_release(work_matrices%slambda)
940 538 : DEALLOCATE (work_matrices%slambda)
941 : END IF
942 1352 : IF (ASSOCIATED(work_matrices%S_eigenvalues)) &
943 538 : DEALLOCATE (work_matrices%S_eigenvalues)
944 : ! Ewald
945 1352 : IF (ASSOCIATED(work_matrices%ewald_env)) THEN
946 94 : CALL ewald_env_release(work_matrices%ewald_env)
947 94 : DEALLOCATE (work_matrices%ewald_env)
948 : END IF
949 1352 : IF (ASSOCIATED(work_matrices%ewald_pw)) THEN
950 94 : CALL ewald_pw_release(work_matrices%ewald_pw)
951 94 : DEALLOCATE (work_matrices%ewald_pw)
952 : END IF
953 : ! GAPW
954 1352 : IF (ASSOCIATED(work_matrices%local_rho_set)) THEN
955 416 : CALL local_rho_set_release(work_matrices%local_rho_set)
956 : END IF
957 1352 : IF (ASSOCIATED(work_matrices%local_rho_set_admm)) THEN
958 80 : CALL local_rho_set_release(work_matrices%local_rho_set_admm)
959 : END IF
960 1352 : IF (ASSOCIATED(work_matrices%hartree_local)) THEN
961 344 : CALL hartree_local_release(work_matrices%hartree_local)
962 : END IF
963 : ! GAPW_XC
964 1352 : IF (ASSOCIATED(work_matrices%rho_xc_struct_sub)) THEN
965 72 : CALL qs_rho_release(work_matrices%rho_xc_struct_sub)
966 72 : DEALLOCATE (work_matrices%rho_xc_struct_sub)
967 : END IF
968 :
969 1352 : CALL timestop(handle)
970 :
971 1352 : END SUBROUTINE tddfpt_release_work_matrices
972 :
973 0 : END MODULE qs_tddfpt2_types
|
