(git:da6e80d)
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-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
10 USE cp_dbcsr_api, ONLY: dbcsr_create,&
13 dbcsr_set,&
25 USE cp_fm_types, ONLY: cp_fm_create,&
33 USE kinds, ONLY: dp
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
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, nactive, nao, &
78 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 CALL dbcsr_create(matrixf, template=matrix_s)
103 nmo = SIZE(ex_env%gw_eigen)
104 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
105 nrow_global=nao, ncol_global=nactive)
106 NULLIFY (blacs_env, para_env)
107 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
108
109 occ = SIZE(gs_mos(ispin)%evals_occ)
110 nmo = SIZE(ex_env%gw_eigen)
111 virt = SIZE(gs_mos(ispin)%evals_virt)
112 NULLIFY (fmstruct)
113 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
114 context=blacs_env, nrow_global=virt, ncol_global=virt)
115 CALL cp_fm_create(matrixtmp, fmstruct)
116 CALL cp_fm_struct_release(fmstruct)
117
118 NULLIFY (fmstruct)
119 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
120 context=blacs_env, nrow_global=virt, ncol_global=nao)
121 CALL cp_fm_create(matrixtmp2, fmstruct)
122 CALL cp_fm_struct_release(fmstruct)
123
124 NULLIFY (fmstruct)
125 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
126 context=blacs_env, nrow_global=nao, ncol_global=nao)
127 CALL cp_fm_create(matrixtmp3, fmstruct)
128 CALL cp_fm_create(fms, fmstruct)
129 CALL cp_fm_struct_release(fmstruct)
130 CALL cp_dbcsr_alloc_block_from_nbl(matrixf, sab_orb)
131
132!--add virt eigenvalues
133 CALL dbcsr_set(matrixf, 0.0_dp)
134 CALL cp_fm_create(weighted_vect, gs_mos(ispin)%mos_virt%matrix_struct)
135 CALL cp_fm_create(sweighted_vect, gs_mos(ispin)%mos_virt%matrix_struct)
136 CALL cp_fm_to_fm(gs_mos(ispin)%mos_virt, weighted_vect)
137 CALL copy_dbcsr_to_fm(matrix_s, fms)
138
139 ALLOCATE (gw_virt(virt))
140 ALLOCATE (gw_occ(occ))
141 gw_virt(1:virt) = ex_env%gw_eigen(occ + 1:nmo)
142 gw_occ(1:occ) = ex_env%gw_eigen(1:occ)
143
144 CALL cp_fm_set_all(matrixtmp, 0.0_dp)
145 DO i = 1, virt
146 CALL cp_fm_set_element(matrixtmp, i, i, gw_virt(i))
147 END DO
148 DEALLOCATE (gw_virt)
149 CALL cp_fm_gemm('N', 'N', nao, virt, nao, 1.0_dp, fms, weighted_vect, 0.0_dp, &
150 sweighted_vect)
151 CALL cp_fm_gemm('N', 'T', virt, nao, virt, 1.0_dp, matrixtmp, sweighted_vect, 0.0_dp, &
152 matrixtmp2)
153 CALL cp_fm_gemm('N', 'N', nao, nao, virt, 1.0_dp, sweighted_vect, matrixtmp2, 0.0_dp, &
154 matrixtmp3)
155 CALL copy_fm_to_dbcsr(matrixtmp3, matrixf)
156
157 CALL cp_fm_release(weighted_vect)
158 CALL cp_fm_release(sweighted_vect)
159 CALL cp_fm_release(fms)
160!--add occ eigenvalues
161 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
162 nrow_global=nao, ncol_global=nactive)
163 CALL cp_fm_create(hevec, matrix_struct)
164
165 DO ivect = 1, nvects
166 CALL cp_dbcsr_sm_fm_multiply(matrixf, evects(ispin, ivect), &
167 aop_evects(ispin, ivect), ncol=nactive, &
168 alpha=1.0_dp, beta=1.0_dp)
169
170 CALL cp_fm_to_fm(s_evects(ispin, ivect), hevec)
171 CALL cp_fm_column_scale(hevec, gw_occ)
172
173 CALL cp_fm_scale_and_add(1.0_dp, aop_evects(ispin, ivect), -1.0_dp, hevec)
174 END DO !ivect
175 DEALLOCATE (gw_occ)
176
177 CALL cp_fm_release(matrixtmp)
178 CALL cp_fm_release(matrixtmp2)
179 CALL cp_fm_release(matrixtmp3)
180
181 CALL dbcsr_release(matrixf)
182 CALL cp_fm_release(hevec)
183 END DO !ispin
184
185 virt = SIZE(aop_evects, 2)
186 CALL timestop(handle)
187
188 END SUBROUTINE zeroth_order_gw
189
190! **************************************************************************************************
191!> \brief Update action of TDDFPT operator on trial vectors by adding BSE W term.
192!> \param Aop_evects ...
193!> \param evects ...
194!> \param gs_mos ...
195!> \param qs_env ...
196!> \note Based on the subroutine tddfpt_apply_hfx() which was originally created by
197!> Mohamed Fawzi on 10.2002.
198! **************************************************************************************************
199 SUBROUTINE tddfpt_apply_bse(Aop_evects, evects, gs_mos, qs_env)
200
201 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(INOUT) :: aop_evects
202 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evects
203 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
204 INTENT(in) :: gs_mos
205 TYPE(qs_environment_type), POINTER :: qs_env
206
207 CHARACTER(LEN=*), PARAMETER :: routinen = 'tddfpt_apply_bse'
208
209 INTEGER :: a_nao_col, a_virt_col, b_nao_col, c_virt_col, handle, i_occ_row, i_row_global, &
210 ii, ispin, ivect, j_col_global, j_occ_row, jj, k_occ_col, mu_col_global, nao, ncol_block, &
211 ncol_local, nrow_block, nrow_local, nspins, nvects, nvirt
212 INTEGER, DIMENSION(2) :: nactive
213 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
214 REAL(kind=dp) :: alpha
215 TYPE(cp_blacs_env_type), POINTER :: blacs_env
216 TYPE(cp_fm_struct_type), POINTER :: fmstruct, matrix_struct
217 TYPE(cp_fm_type) :: csvirt, fms, wxaoao, wxmat2, wxvirtao
218 TYPE(cp_fm_type), POINTER :: bse_w_matrix_mo
219 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
220 TYPE(excited_energy_type), POINTER :: ex_env
221 TYPE(mp_para_env_type), POINTER :: para_env
222
223 CALL timeset(routinen, handle)
224
225 nspins = SIZE(evects, 1)
226 nvects = SIZE(evects, 2)
227 IF (nspins > 1) THEN
228 alpha = 1.0_dp
229 ELSE
230 alpha = 2.0_dp
231 END IF
232 CALL cp_fm_get_info(gs_mos(1)%mos_occ, nrow_global=nao)
233 DO ispin = 1, nspins
234 CALL cp_fm_get_info(evects(ispin, 1), ncol_global=nactive(ispin))
235 END DO
236
237 NULLIFY (ex_env, para_env, blacs_env, matrix_s)
238 CALL get_qs_env(qs_env, exstate_env=ex_env, para_env=para_env, blacs_env=blacs_env, &
239 matrix_s=matrix_s)
240
241 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
242 context=blacs_env, nrow_global=nao, ncol_global=nao)
243 CALL cp_fm_create(fms, fmstruct)
244 CALL cp_fm_struct_release(fmstruct)
245 CALL copy_dbcsr_to_fm(matrix_s(1)%matrix, fms)
246
247 NULLIFY (bse_w_matrix_mo)
248 bse_w_matrix_mo => ex_env%bse_w_matrix_MO(1, 1)
249
250 DO ivect = 1, nvects
251 DO ispin = 1, nspins
252 NULLIFY (matrix_struct, fmstruct)
253 CALL cp_fm_get_info(matrix=evects(ispin, 1), matrix_struct=matrix_struct, &
254 nrow_global=nao, ncol_global=nactive(ispin))
255 nvirt = SIZE(gs_mos(ispin)%evals_virt)
256
257 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
258 context=blacs_env, nrow_global=nvirt, ncol_global=nao)
259 CALL cp_fm_create(csvirt, fmstruct)
260 CALL cp_fm_struct_release(fmstruct)
261
262 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
263 context=blacs_env, nrow_global=nactive(ispin)*nactive(ispin), &
264 ncol_global=nvirt*nao)
265 CALL cp_fm_create(wxvirtao, fmstruct)
266 CALL cp_fm_struct_release(fmstruct)
267 CALL cp_fm_set_all(wxvirtao, 0.0_dp)
268
269 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
270 context=blacs_env, nrow_global=nactive(ispin)*nactive(ispin), &
271 ncol_global=nao*nao)
272 CALL cp_fm_create(wxaoao, fmstruct)
273 CALL cp_fm_struct_release(fmstruct)
274 CALL cp_fm_set_all(wxaoao, 0.0_dp)
275
276 CALL cp_fm_gemm('T', 'N', nvirt, nao, nao, 1.0_dp, gs_mos(ispin)%mos_virt, fms, 0.0_dp, &
277 csvirt)
278 NULLIFY (row_indices, col_indices)
279 CALL cp_fm_get_info(matrix=wxvirtao, nrow_local=nrow_local, ncol_local=ncol_local, &
280 row_indices=row_indices, col_indices=col_indices, &
281 nrow_block=nrow_block, ncol_block=ncol_block)
282
283 CALL cp_fm_set_all(wxvirtao, 0.0_dp)
284 DO ii = 1, nrow_local
285 i_row_global = row_indices(ii)
286 DO jj = 1, ncol_local
287 j_col_global = col_indices(jj)
288
289 i_occ_row = (i_row_global - 1)/nactive(ispin) + 1
290 j_occ_row = mod(i_row_global - 1, nactive(ispin)) + 1
291
292 a_virt_col = (j_col_global - 1)/nao + 1
293 b_nao_col = mod(j_col_global - 1, nao) + 1
294
295 DO c_virt_col = 1, nvirt
296 mu_col_global = (a_virt_col - 1)*nvirt + c_virt_col
297
298 wxvirtao%local_data(i_row_global, j_col_global) = wxvirtao%local_data(i_row_global, j_col_global) + &
299 bse_w_matrix_mo%local_data(i_row_global, mu_col_global)*csvirt%local_data(c_virt_col, b_nao_col)
300
301 END DO
302 END DO
303 END DO
304
305 NULLIFY (row_indices, col_indices) ! redefine indices
306 CALL cp_fm_get_info(matrix=wxaoao, nrow_local=nrow_local, ncol_local=ncol_local, &
307 row_indices=row_indices, col_indices=col_indices, &
308 nrow_block=nrow_block, ncol_block=ncol_block)
309
310 CALL cp_fm_set_all(wxaoao, 0.0_dp)
311 DO ii = 1, nrow_local
312 i_row_global = row_indices(ii)
313 DO jj = 1, ncol_local
314 j_col_global = col_indices(jj)
315
316 i_occ_row = (i_row_global - 1)/nactive(ispin) + 1
317 j_occ_row = mod(i_row_global - 1, nactive(ispin)) + 1
318
319 a_nao_col = (j_col_global - 1)/nao + 1
320 b_nao_col = mod(j_col_global - 1, nao) + 1
321
322 DO k_occ_col = 1, nvirt
323 mu_col_global = (k_occ_col - 1)*nao + a_nao_col
324
325 wxaoao%local_data(i_row_global, j_col_global) = wxaoao%local_data(i_row_global, j_col_global) + &
326 wxvirtao%local_data(i_row_global, mu_col_global)*csvirt%local_data(k_occ_col, b_nao_col)
327
328 END DO
329 END DO
330 END DO
331
332 CALL cp_fm_release(wxvirtao)
333 CALL cp_fm_release(csvirt)
334
335 CALL cp_fm_struct_create(fmstruct=fmstruct, para_env=para_env, &
336 context=blacs_env, nrow_global=nao, ncol_global=nactive(ispin))
337 CALL cp_fm_create(wxmat2, fmstruct)
338 CALL cp_fm_struct_release(fmstruct)
339 CALL cp_fm_set_all(wxmat2, 0.0_dp)
340
341 DO ii = 1, nrow_local
342 i_row_global = row_indices(ii)
343 DO jj = 1, ncol_local
344 j_col_global = col_indices(jj)
345
346 i_occ_row = (i_row_global - 1)/nactive(ispin) + 1
347 j_occ_row = mod(i_row_global - 1, nactive(ispin)) + 1
348 a_nao_col = (j_col_global - 1)/nao + 1
349 b_nao_col = mod(j_col_global - 1, nao) + 1
350 IF (a_nao_col .EQ. b_nao_col) THEN
351 wxmat2%local_data(b_nao_col, i_occ_row) = wxmat2%local_data(b_nao_col, i_occ_row) + &
352 wxaoao%local_data(i_row_global, j_col_global)*evects(ispin, ivect)%local_data(a_nao_col, j_occ_row)
353 END IF
354 IF (a_nao_col .NE. b_nao_col) THEN
355 wxmat2%local_data(a_nao_col, i_occ_row) = wxmat2%local_data(a_nao_col, i_occ_row) + &
356 wxaoao%local_data(i_row_global, j_col_global)*evects(ispin, ivect)%local_data(b_nao_col, j_occ_row)
357 END IF
358 END DO
359 END DO
360
361 CALL cp_fm_release(wxaoao)
362
363 CALL cp_fm_scale_and_add(1.0_dp, aop_evects(ispin, ivect), -1.0_dp, wxmat2)
364
365 CALL cp_fm_release(wxmat2)
366
367 END do! ispin
368 END DO !ivect
369
370 CALL cp_fm_release(fms)
371
372 CALL timestop(handle)
373
374 END SUBROUTINE tddfpt_apply_bse
375END MODULE qs_tddfpt2_bse_utils
methods related to the blacs parallel environment
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_release(matrix)
...
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Basic linear algebra operations for full matrices.
subroutine, public cp_fm_gemm(transa, transb, m, n, k, alpha, matrix_a, matrix_b, beta, matrix_c, a_first_col, a_first_row, b_first_col, b_first_row, c_first_col, c_first_row)
computes matrix_c = beta * matrix_c + alpha * ( matrix_a ** transa ) * ( matrix_b ** transb )
subroutine, public cp_fm_column_scale(matrixa, scaling)
scales column i of matrix a with scaling(i)
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....
represent the structure of a full matrix
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
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
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
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
subroutine, public cp_fm_set_element(matrix, irow_global, icol_global, alpha)
sets an element of a matrix
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
Types for excited states potential energies.
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
Interface to the message passing library MPI.
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, 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, 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.
Define the neighbor list data types and the corresponding functionality.
subroutine, public zeroth_order_gw(qs_env, aop_evects, evects, s_evects, gs_mos, matrix_s, matrix_ks)
...
subroutine, public tddfpt_apply_bse(aop_evects, evects, gs_mos, qs_env)
Update action of TDDFPT operator on trial vectors by adding BSE W term.
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
keeps the information about the structure of a full matrix
represent a full matrix
Contains information on the excited states energy.
stores all the informations relevant to an mpi environment
Ground state molecular orbitals.