(git:495eafe)
Loading...
Searching...
No Matches
qs_tddfpt2_bse_utils.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8MODULE qs_tddfpt2_bse_utils
9 USE cp_blacs_env, ONLY: cp_blacs_env_type
10 USE cp_dbcsr_api, ONLY: dbcsr_create,&
11 dbcsr_p_type,&
12 dbcsr_release,&
13 dbcsr_set,&
14 dbcsr_type
15 USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
16 USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
17 copy_fm_to_dbcsr,&
18 cp_dbcsr_sm_fm_multiply
19 USE cp_fm_basic_linalg, ONLY: cp_fm_column_scale,&
20 cp_fm_matvec,&
21 cp_fm_scale_and_add
22 USE cp_fm_struct, ONLY: cp_fm_struct_create,&
23 cp_fm_struct_release,&
24 cp_fm_struct_type
25 USE cp_fm_types, ONLY: &
26 cp_fm_create, cp_fm_get_info, cp_fm_release, cp_fm_set_all, cp_fm_set_element, &
27 cp_fm_to_fm, cp_fm_to_fm_submat, cp_fm_type, cp_fm_vectorssum, cp_fm_write_formatted
28 USE cp_log_handling, ONLY: cp_get_default_logger,&
29 cp_logger_get_default_io_unit,&
30 cp_logger_type
31 USE exstates_types, ONLY: excited_energy_type
32 USE kinds, ONLY: dp
33 USE message_passing, ONLY: mp_para_env_type
34 USE parallel_gemm_api, ONLY: parallel_gemm
35 USE qs_environment_types, ONLY: get_qs_env,&
36 qs_environment_type
37 USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
38 USE qs_tddfpt2_types, ONLY: tddfpt_ground_state_mos
39#include "./base/base_uses.f90"
40
41 IMPLICIT NONE
42
43 PRIVATE
44
45 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_bse_utils'
46
47 LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .false.
48 ! number of first derivative components (3: d/dx, d/dy, d/dz)
49 INTEGER, PARAMETER, PRIVATE :: nderivs = 3
50 INTEGER, PARAMETER, PRIVATE :: maxspins = 2
51
52 PUBLIC:: tddfpt_apply_bse_debug, tddfpt_apply_bse
53 PUBLIC:: zeroth_order_gw
54
55CONTAINS
56! **************************************************************************************************
57!> \brief ...
58!> \param qs_env ...
59!> \param Aop_evects ...
60!> \param evects ...
61!> \param S_evects ...
62!> \param gs_mos ...
63!> \param matrix_s ...
64!> \param matrix_ks ...
65! **************************************************************************************************
66 SUBROUTINE zeroth_order_gw(qs_env, Aop_evects, evects, S_evects, gs_mos, matrix_s, matrix_ks)
67 TYPE(qs_environment_type), POINTER :: qs_env
68 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: aop_evects
69 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects, s_evects
70 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
71 INTENT(in) :: gs_mos
72 TYPE(dbcsr_type), INTENT(in), POINTER :: matrix_s
73 TYPE(dbcsr_p_type), DIMENSION(:), INTENT(in) :: matrix_ks
74
75 CHARACTER(LEN=*), PARAMETER :: routinen = 'zeroth_order_gw'
76
77 INTEGER :: handle, i, ispin, ivect, j, nactive, &
78 nao, nmo, nspins, nvects, occ, virt
79 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: gw_occ, gw_virt
80 TYPE(cp_blacs_env_type), POINTER :: blacs_env
81 TYPE(cp_fm_struct_type), POINTER :: fmstruct, matrix_struct
82 TYPE(cp_fm_type) :: fms, hevec, matrixtmp, matrixtmp2, &
83 matrixtmp3, sweighted_vect, &
84 weighted_vect
85 TYPE(dbcsr_type) :: matrixf
86 TYPE(excited_energy_type), POINTER :: ex_env
87 TYPE(mp_para_env_type), POINTER :: para_env
88 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
89 POINTER :: sab_orb
90
91 CALL timeset(routinen, handle)
92
93 NULLIFY (ex_env, sab_orb)
94 CALL get_qs_env(qs_env, exstate_env=ex_env, sab_orb=sab_orb)
95
96 nspins = SIZE(matrix_ks, 1)
97 nspins = SIZE(evects, 1)
98 nvects = SIZE(evects, 2)
99
100 DO ispin = 1, nspins
101
102 cpassert(.NOT. ASSOCIATED(gs_mos(ispin)%evals_occ_matrix))
103
104 CALL dbcsr_create(matrixf, template=matrix_s)
105 nmo = SIZE(ex_env%gw_eigen)
106 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
107 nrow_global=nao, ncol_global=nactive)
108 NULLIFY (blacs_env, para_env)
109 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
110
111 occ = SIZE(gs_mos(ispin)%evals_occ)
112 nactive = gs_mos(ispin)%nmo_active
113 nmo = SIZE(ex_env%gw_eigen)
114 virt = SIZE(gs_mos(ispin)%evals_virt)
115 NULLIFY (fmstruct)
116 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
117 context=blacs_env, nrow_global=virt, ncol_global=virt)
118 CALL cp_fm_create(matrixtmp, fmstruct)
119 CALL cp_fm_struct_release(fmstruct)
120
121 NULLIFY (fmstruct)
122 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
123 context=blacs_env, nrow_global=virt, ncol_global=nao)
124 CALL cp_fm_create(matrixtmp2, fmstruct)
125 CALL cp_fm_struct_release(fmstruct)
126
127 NULLIFY (fmstruct)
128 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
129 context=blacs_env, nrow_global=nao, ncol_global=nao)
130 CALL cp_fm_create(matrixtmp3, fmstruct)
131 CALL cp_fm_create(fms, fmstruct)
132 CALL cp_fm_struct_release(fmstruct)
133 CALL cp_dbcsr_alloc_block_from_nbl(matrixf, sab_orb)
134
135!--add virt eigenvalues
136 CALL dbcsr_set(matrixf, 0.0_dp)
137 CALL cp_fm_create(weighted_vect, gs_mos(ispin)%mos_virt%matrix_struct)
138 CALL cp_fm_create(sweighted_vect, gs_mos(ispin)%mos_virt%matrix_struct)
139 CALL cp_fm_to_fm(gs_mos(ispin)%mos_virt, weighted_vect)
140 CALL copy_dbcsr_to_fm(matrix_s, fms)
141
142 ALLOCATE (gw_virt(virt))
143 ALLOCATE (gw_occ(nactive))
144 gw_virt(1:virt) = ex_env%gw_eigen(occ + 1:nmo)
145 DO i = 1, nactive
146 j = gs_mos(ispin)%index_active(i)
147 gw_occ(i) = ex_env%gw_eigen(j)
148 END DO
149
150 CALL cp_fm_set_all(matrixtmp, 0.0_dp)
151 DO i = 1, virt
152 CALL cp_fm_set_element(matrixtmp, i, i, gw_virt(i))
153 END DO
154 DEALLOCATE (gw_virt)
155 CALL parallel_gemm('N', 'N', nao, virt, nao, 1.0_dp, fms, weighted_vect, 0.0_dp, sweighted_vect)
156 CALL parallel_gemm('N', 'T', virt, nao, virt, 1.0_dp, matrixtmp, sweighted_vect, 0.0_dp, matrixtmp2)
157 CALL parallel_gemm('N', 'N', nao, nao, virt, 1.0_dp, sweighted_vect, matrixtmp2, 0.0_dp, matrixtmp3)
158 CALL copy_fm_to_dbcsr(matrixtmp3, matrixf)
159
160 CALL cp_fm_release(weighted_vect)
161 CALL cp_fm_release(sweighted_vect)
162 CALL cp_fm_release(fms)
163!--add occ eigenvalues
164 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
165 nrow_global=nao, ncol_global=nactive)
166 CALL cp_fm_create(hevec, matrix_struct)
167
168 DO ivect = 1, nvects
169 CALL cp_dbcsr_sm_fm_multiply(matrixf, evects(ispin, ivect), &
170 aop_evects(ispin, ivect), ncol=nactive, &
171 alpha=1.0_dp, beta=1.0_dp)
172
173 CALL cp_fm_to_fm(s_evects(ispin, ivect), hevec)
174 CALL cp_fm_column_scale(hevec, gw_occ)
175
176 CALL cp_fm_scale_and_add(1.0_dp, aop_evects(ispin, ivect), -1.0_dp, hevec)
177 END DO !ivect
178 DEALLOCATE (gw_occ)
179
180 CALL cp_fm_release(matrixtmp)
181 CALL cp_fm_release(matrixtmp2)
182 CALL cp_fm_release(matrixtmp3)
183
184 CALL dbcsr_release(matrixf)
185 CALL cp_fm_release(hevec)
186 END DO !ispin
187
188 virt = SIZE(aop_evects, 2)
189 CALL timestop(handle)
190
191 END SUBROUTINE zeroth_order_gw
192
193! **************************************************************************************************
194!> \brief Update action of TDDFPT operator on trial vectors by adding BSE W term.
195!> \brief debug version
196!> \param Aop_evects ...
197!> \param evects ...
198!> \param gs_mos ...
199!> \param qs_env ...
200! **************************************************************************************************
201 SUBROUTINE tddfpt_apply_bse_debug(Aop_evects, evects, gs_mos, qs_env)
202
203 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: aop_evects
204 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects
205 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
206 INTENT(in) :: gs_mos
207 TYPE(qs_environment_type), POINTER :: qs_env
208
209 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_apply_bse_debug'
210
211 INTEGER :: a_nao_col, a_virt_col, b_nao_col, c_virt_col, handle, i_occ_row, i_row_global, &
212 ii, iounit, ispin, ivect, j_col_global, j_occ_row, jj, k_occ_col, mu_col_global, nao, &
213 ncol_block, ncol_block_bse, ncol_block_cs, ncol_local, ncol_local_bse, ncol_local_cs, &
214 nrow_block, nrow_block_bse, nrow_block_cs, nrow_local, nrow_local_bse, nrow_local_cs, &
215 nspins, nvects, nvirt
216 INTEGER, DIMENSION(2) :: nactive
217 INTEGER, DIMENSION(:), POINTER :: col_indices, col_indices_bse, &
218 col_indices_cs, row_indices, &
219 row_indices_bse, row_indices_cs
220 REAL(kind=dp) :: alpha
221 REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :), &
222 POINTER :: my_block, my_bse_w_matrix_mo, my_csvirt
223 TYPE(cp_blacs_env_type), POINTER :: blacs_env
224 TYPE(cp_fm_struct_type), POINTER :: fmstruct, matrix_struct
225 TYPE(cp_fm_type) :: csvirt, fms, wxaoao, wxmat2, wxvirtao
226 TYPE(cp_fm_type), POINTER :: bse_w_matrix_mo
227 TYPE(cp_logger_type), POINTER :: logger
228 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
229 TYPE(excited_energy_type), POINTER :: ex_env
230 TYPE(mp_para_env_type), POINTER :: para_env
231
232 NULLIFY (logger) !get output_unit
233 logger => cp_get_default_logger()
234 iounit = cp_logger_get_default_io_unit(logger)
235
236 CALL timeset(routinen, handle)
237
238 nspins = SIZE(evects, 1)
239 nvects = SIZE(evects, 2)
240 IF (nspins > 1) THEN
241 alpha = 1.0_dp
242 ELSE
243 alpha = 2.0_dp
244 END IF
245 CALL cp_fm_get_info(gs_mos(1)%mos_occ, nrow_global=nao)
246 DO ispin = 1, nspins
247 CALL cp_fm_get_info(evects(ispin, 1), ncol_global=nactive(ispin))
248 END DO
249
250 NULLIFY (ex_env, para_env, blacs_env, matrix_s)
251 CALL get_qs_env(qs_env, exstate_env=ex_env, para_env=para_env, blacs_env=blacs_env, &
252 matrix_s=matrix_s)
253
254 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
255 context=blacs_env, nrow_global=nao, ncol_global=nao)
256 CALL cp_fm_create(fms, fmstruct)
257 CALL cp_fm_struct_release(fmstruct)
258 CALL copy_dbcsr_to_fm(matrix_s(1)%matrix, fms)
259
260 NULLIFY (bse_w_matrix_mo)
261 bse_w_matrix_mo => ex_env%bse_w_matrix_MO(1, 1)
262
263 DO ivect = 1, nvects
264 DO ispin = 1, nspins
265 NULLIFY (matrix_struct, fmstruct)
266 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
267 nrow_global=nao, ncol_global=nactive(ispin))
268 nvirt = SIZE(gs_mos(ispin)%evals_virt)
269
270 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
271 context=blacs_env, nrow_global=nvirt, ncol_global=nao)
272 CALL cp_fm_create(csvirt, fmstruct)
273 CALL cp_fm_struct_release(fmstruct)
274
275 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
276 context=blacs_env, nrow_global=nactive(ispin)*nactive(ispin), &
277 ncol_global=nvirt*nao)
278 CALL cp_fm_create(wxvirtao, fmstruct)
279 CALL cp_fm_struct_release(fmstruct)
280 CALL cp_fm_set_all(wxvirtao, 0.0_dp)
281
282 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
283 context=blacs_env, nrow_global=nactive(ispin)*nactive(ispin), &
284 ncol_global=nao*nao)
285 CALL cp_fm_create(wxaoao, fmstruct)
286 CALL cp_fm_struct_release(fmstruct)
287 CALL cp_fm_set_all(wxaoao, 0.0_dp)
288
289 CALL parallel_gemm('T', 'N', nvirt, nao, nao, 1.0_dp, gs_mos(ispin)%mos_virt, fms, 0.0_dp, csvirt)
290 NULLIFY (row_indices, col_indices)
291 CALL cp_fm_get_info(matrix=wxvirtao, nrow_local=nrow_local, ncol_local=ncol_local, &
292 row_indices=row_indices, col_indices=col_indices, &
293 nrow_block=nrow_block, ncol_block=ncol_block, local_data=my_block)
294 CALL cp_fm_get_info(matrix=csvirt, nrow_local=nrow_local_cs, ncol_local=ncol_local_cs, &
295 row_indices=row_indices_cs, col_indices=col_indices_cs, &
296 nrow_block=nrow_block_cs, ncol_block=ncol_block_cs, local_data=my_csvirt)
297 CALL cp_fm_get_info(matrix=bse_w_matrix_mo, nrow_local=nrow_local_bse, ncol_local=ncol_local_bse, &
298 row_indices=row_indices_bse, col_indices=col_indices_bse, &
299 nrow_block=nrow_block_bse, ncol_block=ncol_block_bse, local_data=my_bse_w_matrix_mo)
300
301 CALL cp_fm_set_all(wxvirtao, 0.0_dp)
302
303 DO ii = 1, nrow_local
304 i_row_global = row_indices(ii)
305 DO jj = 1, ncol_local
306 j_col_global = col_indices(jj)
307
308 i_occ_row = (i_row_global - 1)/nactive(ispin) + 1
309 j_occ_row = mod(i_row_global - 1, nactive(ispin)) + 1
310 a_virt_col = (j_col_global - 1)/nao + 1
311 b_nao_col = mod(j_col_global - 1, nao) + 1
312
313 DO c_virt_col = 1, nvirt
314 mu_col_global = (a_virt_col - 1)*nvirt + c_virt_col
315
316 wxvirtao%local_data(i_row_global, j_col_global) = wxvirtao%local_data(i_row_global, j_col_global) + &
317 bse_w_matrix_mo%local_data(i_row_global, mu_col_global)*csvirt%local_data(c_virt_col, b_nao_col)
318
319 END DO
320 END DO
321 END DO
322
323 NULLIFY (row_indices, col_indices) ! redefine indices
324 CALL cp_fm_get_info(matrix=wxaoao, nrow_local=nrow_local, ncol_local=ncol_local, &
325 row_indices=row_indices, col_indices=col_indices, &
326 nrow_block=nrow_block, ncol_block=ncol_block)
327
328 CALL cp_fm_set_all(wxaoao, 0.0_dp)
329 DO ii = 1, nrow_local
330 i_row_global = row_indices(ii)
331 DO jj = 1, ncol_local
332 j_col_global = col_indices(jj)
333
334 i_occ_row = (i_row_global - 1)/nactive(ispin) + 1
335 j_occ_row = mod(i_row_global - 1, nactive(ispin)) + 1
336 a_nao_col = (j_col_global - 1)/nao + 1
337 b_nao_col = mod(j_col_global - 1, nao) + 1
338
339 DO k_occ_col = 1, nvirt
340 mu_col_global = (k_occ_col - 1)*nao + a_nao_col
341
342 wxaoao%local_data(i_row_global, j_col_global) = wxaoao%local_data(i_row_global, j_col_global) + &
343 wxvirtao%local_data(i_row_global, mu_col_global)*csvirt%local_data(k_occ_col, b_nao_col)
344
345 END DO
346 END DO
347 END DO
348
349 CALL cp_fm_release(wxvirtao)
350 CALL cp_fm_release(csvirt)
351
352 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
353 context=blacs_env, nrow_global=nao, ncol_global=nactive(ispin))
354 CALL cp_fm_create(wxmat2, fmstruct)
355 CALL cp_fm_struct_release(fmstruct)
356 CALL cp_fm_set_all(wxmat2, 0.0_dp)
357
358 DO ii = 1, nrow_local
359 i_row_global = row_indices(ii)
360 DO jj = 1, ncol_local
361 j_col_global = col_indices(jj)
362
363 i_occ_row = (i_row_global - 1)/nactive(ispin) + 1
364 j_occ_row = mod(i_row_global - 1, nactive(ispin)) + 1
365 a_nao_col = (j_col_global - 1)/nao + 1
366 b_nao_col = mod(j_col_global - 1, nao) + 1
367
368 wxmat2%local_data(a_nao_col, i_occ_row) = wxmat2%local_data(a_nao_col, i_occ_row) + &
369 wxaoao%local_data(i_row_global, j_col_global)*evects(ispin, ivect)%local_data(b_nao_col, j_occ_row)
370 END DO
371 END DO
372
373 CALL cp_fm_release(wxaoao)
374
375 IF (iounit > 0) THEN
376 CALL cp_fm_write_formatted(wxmat2, iounit, "WXmat2")
377 END IF
378
379 CALL cp_fm_scale_and_add(1.0_dp, aop_evects(ispin, ivect), -1.0_dp, wxmat2)
380
381 CALL cp_fm_release(wxmat2)
382
383 END do! ispin
384 END DO !ivect
385
386 CALL cp_fm_release(fms)
387
388 CALL timestop(handle)
389
390 END SUBROUTINE tddfpt_apply_bse_debug
391
392! **************************************************************************************************
393!> \brief ...
394!> \param Aop_evects ...
395!> \param evects ...
396!> \param gs_mos ...
397!> \param qs_env ...
398!> \param S_evects ...
399! **************************************************************************************************
400 SUBROUTINE tddfpt_apply_bse(Aop_evects, evects, gs_mos, qs_env, S_evects)
401
402 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: aop_evects
403 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects
404 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
405 INTENT(in) :: gs_mos
406 TYPE(qs_environment_type), POINTER :: qs_env
407 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: s_evects
408
409 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_apply_bse'
410
411 INTEGER :: handle, ispin, ivect, nao, nspins, &
412 nvects, nvirt
413 INTEGER, DIMENSION(2) :: nactive
414 REAL(kind=dp) :: alpha
415 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eigvec_entries, rho
416 TYPE(cp_blacs_env_type), POINTER :: blacs_env
417 TYPE(cp_fm_struct_type), POINTER :: fmstruct
418 TYPE(cp_fm_type) :: csvirt, evects_mo, evects_unsplit, fms, &
419 rhomu, rhosplit
420 TYPE(cp_fm_type), POINTER :: bse_a_matrix_mo
421 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
422 TYPE(excited_energy_type), POINTER :: ex_env
423 TYPE(mp_para_env_type), POINTER :: para_env
424
425 CALL timeset(routinen, handle)
426
427 nspins = SIZE(evects, 1)
428 nvects = SIZE(evects, 2)
429 IF (nspins > 1) THEN
430 alpha = 1.0_dp
431 ELSE
432 alpha = 2.0_dp
433 END IF
434 CALL cp_fm_get_info(gs_mos(1)%mos_occ, nrow_global=nao)
435 DO ispin = 1, nspins
436 CALL cp_fm_get_info(evects(ispin, 1), ncol_global=nactive(ispin))
437 END DO
438
439 NULLIFY (ex_env, para_env, blacs_env, matrix_s)
440 CALL get_qs_env(qs_env, exstate_env=ex_env, para_env=para_env, blacs_env=blacs_env, &
441 matrix_s=matrix_s)
442
443 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
444 context=blacs_env, nrow_global=nao, ncol_global=nao)
445 CALL cp_fm_create(fms, fmstruct)
446 CALL cp_fm_struct_release(fmstruct)
447 CALL copy_dbcsr_to_fm(matrix_s(1)%matrix, fms)
448
449 NULLIFY (bse_a_matrix_mo)
450 bse_a_matrix_mo => ex_env%bse_a_matrix_MO(1, 1)
451 para_env => bse_a_matrix_mo%matrix_struct%para_env
452
453 DO ivect = 1, nvects
454 DO ispin = 1, nspins
455 NULLIFY (fmstruct)
456 CALL cp_fm_get_info(matrix=evects(ispin, 1), &
457 nrow_global=nao, ncol_global=nactive(ispin))
458 nvirt = SIZE(gs_mos(ispin)%evals_virt)
459
460 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
461 context=blacs_env, nrow_global=nvirt, ncol_global=nao)
462 CALL cp_fm_create(csvirt, fmstruct)
463 CALL cp_fm_struct_release(fmstruct)
464 CALL parallel_gemm('T', 'N', nvirt, nao, nao, 1.0_dp, gs_mos(ispin)%mos_virt, &
465 fms, 0.0_dp, csvirt)
466
467 NULLIFY (fmstruct)
468 CALL cp_fm_struct_create(fmstruct, para_env=para_env, context=blacs_env, &
469 nrow_global=nvirt, ncol_global=nactive(ispin))
470 CALL cp_fm_create(evects_mo, fmstruct)
471 CALL cp_fm_struct_release(fmstruct)
472 NULLIFY (fmstruct)
473 CALL cp_fm_struct_create(fmstruct, para_env=para_env, context=blacs_env, &
474 nrow_global=nvirt, ncol_global=nactive(ispin))
475 CALL cp_fm_create(rhosplit, fmstruct)
476 CALL cp_fm_struct_release(fmstruct)
477 NULLIFY (fmstruct)
478 CALL cp_fm_struct_create(fmstruct, para_env=para_env, context=blacs_env, &
479 nrow_global=nao, ncol_global=nactive(ispin))
480 CALL cp_fm_create(rhomu, fmstruct)
481 CALL cp_fm_struct_release(fmstruct)
482 NULLIFY (fmstruct)
483 CALL cp_fm_struct_create(fmstruct, para_env=para_env, context=blacs_env, &
484 nrow_global=nactive(ispin)*nvirt, ncol_global=1)
485 CALL cp_fm_create(evects_unsplit, fmstruct)
486 CALL cp_fm_struct_release(fmstruct)
487
488! get X_jb
489 CALL parallel_gemm("T", "N", nvirt, nactive(ispin), nao, 1.0_dp, gs_mos(ispin)%mos_virt, &
490 s_evects(ispin, ivect), 0.0_dp, evects_mo)
491! rearrange X_jb
492 CALL contract_bse(evects_mo, evects_unsplit, nactive(ispin), nvirt, eigvec_entries)
493! contract A_iajb X_jb
494 ALLOCATE (rho(nvirt*nactive(ispin)))
495 CALL cp_fm_matvec(bse_a_matrix_mo, eigvec_entries, rho, 1.0_dp, 0.0_dp)
496! rearrange rho_ia
497 CALL split_bse(rho, rhosplit, nvirt)
498! get rho_imu
499 CALL parallel_gemm("T", "N", nao, nactive(ispin), nvirt, 1.0_dp, csvirt, &
500 rhosplit, 0.0_dp, rhomu)
501
502 CALL cp_fm_scale_and_add(1.0_dp, aop_evects(ispin, ivect), 1.0_dp, rhomu)
503
504 CALL cp_fm_release(rhomu)
505 CALL cp_fm_release(csvirt)
506 CALL cp_fm_release(evects_mo)
507 CALL cp_fm_release(rhosplit)
508 CALL cp_fm_release(evects_unsplit)
509 DEALLOCATE (rho)
510 DEALLOCATE (eigvec_entries)
511
512 END do! ispin
513 END DO !ivect
514
515 CALL cp_fm_release(fms)
516
517 CALL timestop(handle)
518
519 END SUBROUTINE tddfpt_apply_bse
520
521! **************************************************************************************************
522!> \brief ...
523!> \param evects_mo ...
524!> \param evects_unsplit ...
525!> \param nactive ...
526!> \param nvirt ...
527!> \param eigvec_entries ...
528! **************************************************************************************************
529 SUBROUTINE contract_bse(evects_mo, evects_unsplit, nactive, nvirt, eigvec_entries)
530 TYPE(cp_fm_type), INTENT(IN) :: evects_mo
531 TYPE(cp_fm_type), INTENT(INOUT) :: evects_unsplit
532 INTEGER :: nactive, nvirt
533 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eigvec_entries
534
535 CHARACTER(LEN=*), PARAMETER :: routinen = 'contract_bse'
536
537 INTEGER :: handle, jj
538
539 CALL timeset(routinen, handle)
540
541 ALLOCATE (eigvec_entries(nvirt*nactive))
542 DO jj = 1, nactive
543 CALL cp_fm_to_fm_submat(msource=evects_mo, mtarget=evects_unsplit, &
544 nrow=nvirt, ncol=1, s_firstrow=1, s_firstcol=jj, &
545 t_firstrow=(jj - 1)*nvirt + 1, t_firstcol=1)
546 END DO
547 CALL cp_fm_vectorssum(evects_unsplit, eigvec_entries, "R")
548
549 CALL timestop(handle)
550 END SUBROUTINE contract_bse
551
552! **************************************************************************************************
553!> \brief ...
554!> \param rho ...
555!> \param rhosplit ...
556!> \param nvirt ...
557! **************************************************************************************************
558 SUBROUTINE split_bse(rho, rhosplit, nvirt)
559 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), &
560 INTENT(IN) :: rho
561 TYPE(cp_fm_type), INTENT(INOUT) :: rhosplit
562 INTEGER, INTENT(IN) :: nvirt
563
564 CHARACTER(LEN=*), PARAMETER :: routinen = 'split_bse'
565
566 INTEGER :: handle, i_occ_row, ii, j_occ_row
567
568 CALL timeset(routinen, handle)
569
570 CALL cp_fm_set_all(rhosplit, 0.0_dp)
571
572 DO ii = 1, SIZE(rho)
573 i_occ_row = (ii - 1)/nvirt + 1
574 j_occ_row = mod(ii - 1, nvirt) + 1
575 CALL cp_fm_set_element(rhosplit, j_occ_row, i_occ_row, rho(ii))
576 END DO
577
578 CALL timestop(handle)
579 END SUBROUTINE split_bse
580
581END MODULE qs_tddfpt2_bse_utils
cp_dbcsr_api::dbcsr_create
Definition cp_dbcsr_api.F:194
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:89
cp_fm_types::cp_fm_to_fm
Definition cp_fm_types.F:84
parallel_gemm_api::parallel_gemm
Definition parallel_gemm_api.F:39
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_set
subroutine, public dbcsr_set(matrix, alpha)
...
Definition cp_dbcsr_api.F:1194
cp_dbcsr_api::dbcsr_release
subroutine, public dbcsr_release(matrix)
...
Definition cp_dbcsr_api.F:1132
cp_dbcsr_cp2k_link
Routines that link DBCSR and CP2K concepts together.
Definition cp_dbcsr_cp2k_link.F:14
cp_dbcsr_cp2k_link::cp_dbcsr_alloc_block_from_nbl
subroutine, public cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize)
allocate the blocks of a dbcsr based on the neighbor list
Definition cp_dbcsr_cp2k_link.F:445
cp_dbcsr_operations
DBCSR operations in CP2K.
Definition cp_dbcsr_operations.F:18
cp_dbcsr_operations::cp_dbcsr_sm_fm_multiply
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
Definition cp_dbcsr_operations.F:552
cp_dbcsr_operations::copy_dbcsr_to_fm
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
Definition cp_dbcsr_operations.F:214
cp_dbcsr_operations::copy_fm_to_dbcsr
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Definition cp_dbcsr_operations.F:111
cp_fm_basic_linalg
Basic linear algebra operations for full matrices.
Definition cp_fm_basic_linalg.F:14
cp_fm_basic_linalg::cp_fm_column_scale
subroutine, public cp_fm_column_scale(matrixa, scaling)
scales column i of matrix a with scaling(i)
Definition cp_fm_basic_linalg.F:1948
cp_fm_basic_linalg::cp_fm_scale_and_add
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
Definition cp_fm_basic_linalg.F:172
cp_fm_basic_linalg::cp_fm_matvec
subroutine, public cp_fm_matvec(amat, xv, yv, alpha, beta)
Calculates yv = alpha*amat*xv + beta*yv where amat: fm matrix xv : vector replicated yv : vector repl...
Definition cp_fm_basic_linalg.F:3254
cp_fm_struct
represent the structure of a full matrix
Definition cp_fm_struct.F:14
cp_fm_struct::cp_fm_struct_create
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
Definition cp_fm_struct.F:132
cp_fm_struct::cp_fm_struct_release
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
Definition cp_fm_struct.F:351
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
cp_fm_types::cp_fm_get_info
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
Definition cp_fm_types.F:1087
cp_fm_types::cp_fm_vectorssum
subroutine, public cp_fm_vectorssum(matrix, sum_array, dir)
summing up all the elements along the matrix's i-th index or
Definition cp_fm_types.F:1323
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp, nrow, ncol, set_zero)
creates a new full matrix with the given structure
Definition cp_fm_types.F:169
cp_fm_types::cp_fm_to_fm_submat
subroutine, public cp_fm_to_fm_submat(msource, mtarget, nrow, ncol, s_firstrow, s_firstcol, t_firstrow, t_firstcol)
copy just a part ot the matrix
Definition cp_fm_types.F:1550
cp_fm_types::cp_fm_set_all
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
Definition cp_fm_types.F:556
cp_fm_types::cp_fm_set_element
subroutine, public cp_fm_set_element(matrix, irow_global, icol_global, alpha)
sets an element of a matrix
Definition cp_fm_types.F:721
cp_fm_types::cp_fm_write_formatted
subroutine, public cp_fm_write_formatted(fm, unit, header, value_format)
Write out a full matrix in plain text.
Definition cp_fm_types.F:2328
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
Definition cp_log_handling.F:515
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
exstates_types
Types for excited states potential energies.
Definition exstates_types.F:14
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
parallel_gemm_api
basic linear algebra operations for full matrixes
Definition parallel_gemm_api.F:14
qs_environment_types
Definition qs_environment_types.F:14
qs_environment_types::get_qs_env
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Definition qs_environment_types.F:530
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition qs_neighbor_list_types.F:17
qs_tddfpt2_bse_utils
Definition qs_tddfpt2_bse_utils.F:8
qs_tddfpt2_bse_utils::zeroth_order_gw
subroutine, public zeroth_order_gw(qs_env, aop_evects, evects, s_evects, gs_mos, matrix_s, matrix_ks)
...
Definition qs_tddfpt2_bse_utils.F:67
qs_tddfpt2_bse_utils::tddfpt_apply_bse
subroutine, public tddfpt_apply_bse(aop_evects, evects, gs_mos, qs_env, s_evects)
...
Definition qs_tddfpt2_bse_utils.F:401
qs_tddfpt2_bse_utils::tddfpt_apply_bse_debug
subroutine, public tddfpt_apply_bse_debug(aop_evects, evects, gs_mos, qs_env)
Update action of TDDFPT operator on trial vectors by adding BSE W term.
Definition qs_tddfpt2_bse_utils.F:202
qs_tddfpt2_types
Definition qs_tddfpt2_types.F:8
cp_blacs_env::cp_blacs_env_type
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Definition cp_blacs_env.F:53
cp_dbcsr_api::dbcsr_p_type
Definition cp_dbcsr_api.F:172
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:176
cp_fm_struct::cp_fm_struct_type
keeps the information about the structure of a full matrix
Definition cp_fm_struct.F:82
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:115
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
exstates_types::excited_energy_type
Contains information on the excited states energy.
Definition exstates_types.F:54
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:743
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:220
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
qs_tddfpt2_types::tddfpt_ground_state_mos
Ground state molecular orbitals.
Definition qs_tddfpt2_types.F:85