(git:374b731)
Loading...
Searching...
No Matches
qs_tddfpt2_soc_utils.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Utilities absorption spectroscopy using TDDFPT with SOC
10!> \author JRVogt (12.2023)
11! **************************************************************************************************
12
13MODULE qs_tddfpt2_soc_utils
14 USE cp_blacs_env, ONLY: cp_blacs_env_type
15 USE cp_cfm_types, ONLY: cp_cfm_get_info,&
16 cp_cfm_get_submatrix,&
17 cp_cfm_type
18 USE cp_control_types, ONLY: tddfpt2_control_type
19 USE cp_dbcsr_operations, ONLY: copy_dbcsr_to_fm,&
20 copy_fm_to_dbcsr,&
21 cp_dbcsr_sm_fm_multiply,&
22 dbcsr_allocate_matrix_set,&
23 dbcsr_deallocate_matrix_set
24 USE cp_fm_basic_linalg, ONLY: cp_fm_schur_product
25 USE cp_fm_struct, ONLY: cp_fm_struct_create,&
26 cp_fm_struct_release,&
27 cp_fm_struct_type
28 USE cp_fm_types, ONLY: cp_fm_create,&
29 cp_fm_get_info,&
30 cp_fm_release,&
31 cp_fm_set_all,&
32 cp_fm_to_fm,&
33 cp_fm_to_fm_submat,&
34 cp_fm_type
35 USE dbcsr_api, ONLY: dbcsr_copy,&
36 dbcsr_create,&
37 dbcsr_desymmetrize,&
38 dbcsr_get_info,&
39 dbcsr_p_type,&
40 dbcsr_release,&
41 dbcsr_type
42 USE input_constants, ONLY: tddfpt_dipole_berry,&
43 tddfpt_dipole_length,&
44 tddfpt_dipole_velocity
45 USE kinds, ONLY: dp
46 USE message_passing, ONLY: mp_para_env_type
47 USE moments_utils, ONLY: get_reference_point
48 USE parallel_gemm_api, ONLY: parallel_gemm
49 USE qs_environment_types, ONLY: get_qs_env,&
50 qs_environment_type
51 USE qs_ks_types, ONLY: qs_ks_env_type
52 USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
53 USE qs_operators_ao, ONLY: p_xyz_ao,&
54 rrc_xyz_ao
55 USE qs_overlap, ONLY: build_overlap_matrix
56 USE qs_tddfpt2_soc_types, ONLY: soc_env_type
57 USE qs_tddfpt2_types, ONLY: tddfpt_ground_state_mos
58
59!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num
60#include "./base/base_uses.f90"
61
62 IMPLICIT NONE
63 PRIVATE
64
65 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_soc_utils'
66
67 PUBLIC :: soc_dipole_operator, soc_contract_evect, resort_evects, dip_vel_op
68
69 !A helper type for SOC
70 TYPE dbcsr_soc_package_type
71 TYPE(dbcsr_type), POINTER :: dbcsr_sg => null()
72 TYPE(dbcsr_type), POINTER :: dbcsr_tp => null()
73 TYPE(dbcsr_type), POINTER :: dbcsr_sc => null()
74 TYPE(dbcsr_type), POINTER :: dbcsr_sf => null()
75 TYPE(dbcsr_type), POINTER :: dbcsr_prod => null()
76 TYPE(dbcsr_type), POINTER :: dbcsr_ovlp => null()
77 TYPE(dbcsr_type), POINTER :: dbcsr_tmp => null()
78 TYPE(dbcsr_type), POINTER :: dbcsr_work => null()
79 END TYPE dbcsr_soc_package_type
80
81CONTAINS
82
83! **************************************************************************************************
84!> \brief Build the atomic dipole operator
85!> \param soc_env ...
86!> \param tddfpt_control informations on how to build the operaot
87!> \param qs_env Qucikstep environment
88!> \param gs_mos ...
89! **************************************************************************************************
90 SUBROUTINE soc_dipole_operator(soc_env, tddfpt_control, qs_env, gs_mos)
91 TYPE(soc_env_type), TARGET :: soc_env
92 TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
93 TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
94 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
95 INTENT(in) :: gs_mos
96
97 CHARACTER(len=*), PARAMETER :: routinen = 'soc_dipole_operator'
98
99 INTEGER :: dim_op, handle, i_dim, nao, nspin
100 REAL(kind=dp), DIMENSION(3) :: reference_point
101 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
102
103 CALL timeset(routinen, handle)
104
105 NULLIFY (matrix_s)
106
107 IF (tddfpt_control%dipole_form == tddfpt_dipole_berry) THEN
108 cpabort("BERRY DIPOLE FORM NOT IMPLEMENTED FOR SOC")
109 END IF
110 !! ONLY RCS have been implemented, Therefore, nspin sould always be 1!
111 nspin = 1
112 !! Number of dimensions should be 3, unless multipole is implemented in the future
113 dim_op = 3
114
115 !! Initzilize the dipmat structure
116 CALL get_qs_env(qs_env, matrix_s=matrix_s)
117 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
118
119 ALLOCATE (soc_env%dipmat_ao(dim_op))
120 DO i_dim = 1, dim_op
121 ALLOCATE (soc_env%dipmat_ao(i_dim)%matrix)
122 CALL dbcsr_copy(soc_env%dipmat_ao(i_dim)%matrix, &
123 matrix_s(1)%matrix, &
124 name="dipole operator matrix")
125 END DO
126
127 SELECT CASE (tddfpt_control%dipole_form)
128 CASE (tddfpt_dipole_length)
129 !!This routine is analog to qs_tddfpt_prperties but only until the rRc_xyz_ao routine
130 !! This will lead to an operator within the nao x nao basis
131 !! qs_tddpft_properies uses nvirt x nocc
132 CALL get_reference_point(reference_point, qs_env=qs_env, &
133 reference=tddfpt_control%dipole_reference, &
134 ref_point=tddfpt_control%dipole_ref_point)
135
136 CALL rrc_xyz_ao(op=soc_env%dipmat_ao, qs_env=qs_env, rc=reference_point, order=1, &
137 minimum_image=.false., soft=.false.)
138 !! This will lead to S C^virt C^virt,T Q_q (vgl Strand et al., J. Chem Phys. 150, 044702, 2019)
139 CALL length_rep(qs_env, gs_mos, soc_env)
140 CASE (tddfpt_dipole_velocity)
141 !!This Routine calcluates the dipole Operator within the velocity-form within the ao basis
142 !!This Operation is only used in xas_tdp and qs_tddfpt_soc, lines uses rmc_x_p_xyz_ao
143 CALL p_xyz_ao(soc_env%dipmat_ao, qs_env, minimum_image=.false.)
144 !! This will precomute SC^virt, (omega^a-omega^i)^-1 and C^virt dS/dq
145 CALL velocity_rep(qs_env, gs_mos, soc_env)
146 CASE DEFAULT
147 cpabort("Unimplemented form of the dipole operator")
148 END SELECT
149
150 CALL timestop(handle)
151
152 END SUBROUTINE soc_dipole_operator
153
154! **************************************************************************************************
155!> \brief ...
156!> \param qs_env ...
157!> \param gs_mos ...
158!> \param soc_env ...
159! **************************************************************************************************
160 SUBROUTINE length_rep(qs_env, gs_mos, soc_env)
161 TYPE(qs_environment_type), POINTER :: qs_env
162 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
163 INTENT(in) :: gs_mos
164 TYPE(soc_env_type), TARGET :: soc_env
165
166 INTEGER :: ideriv, ispin, nao, nderivs, nspins
167 INTEGER, ALLOCATABLE, DIMENSION(:) :: nmo_virt
168 TYPE(cp_blacs_env_type), POINTER :: blacs_env
169 TYPE(cp_fm_struct_type), POINTER :: dip_struct, fm_struct
170 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: s_mos_virt
171 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: dipole_op_mos_occ
172 TYPE(cp_fm_type), POINTER :: dipmat_tmp, wfm_ao_ao
173 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
174 TYPE(dbcsr_type), POINTER :: symm_tmp
175 TYPE(mp_para_env_type), POINTER :: para_env
176
177 CALL get_qs_env(qs_env, matrix_s=matrix_s, blacs_env=blacs_env, para_env=para_env)
178
179 nderivs = 3
180 nspins = 1 !!We only account for rcs, will be changed in the future
181 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
182 ALLOCATE (s_mos_virt(nspins), dipole_op_mos_occ(3, nspins), &
183 wfm_ao_ao, nmo_virt(nspins), symm_tmp, dipmat_tmp)
184
185 CALL cp_fm_struct_create(dip_struct, context=blacs_env, ncol_global=nao, nrow_global=nao, para_env=para_env)
186
187 CALL dbcsr_allocate_matrix_set(soc_env%dipmat, nderivs)
188 CALL dbcsr_desymmetrize(matrix_s(1)%matrix, symm_tmp)
189 DO ideriv = 1, nderivs
190 ALLOCATE (soc_env%dipmat(ideriv)%matrix)
191 CALL dbcsr_create(soc_env%dipmat(ideriv)%matrix, template=symm_tmp, &
192 name="contracted operator", matrix_type="N")
193 DO ispin = 1, nspins
194 CALL cp_fm_create(dipole_op_mos_occ(ideriv, ispin), matrix_struct=dip_struct)
195 END DO
196 END DO
197
198 CALL dbcsr_release(symm_tmp)
199 DEALLOCATE (symm_tmp)
200
201 DO ispin = 1, nspins
202 nmo_virt(ispin) = SIZE(gs_mos(ispin)%evals_virt)
203 CALL cp_fm_get_info(gs_mos(ispin)%mos_virt, matrix_struct=fm_struct)
204 CALL cp_fm_create(wfm_ao_ao, dip_struct)
205 CALL cp_fm_create(s_mos_virt(ispin), fm_struct)
206
207 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, &
208 gs_mos(ispin)%mos_virt, &
209 s_mos_virt(ispin), &
210 ncol=nmo_virt(ispin), alpha=1.0_dp, beta=0.0_dp)
211 CALL parallel_gemm('N', 'T', nao, nao, nmo_virt(ispin), &
212 1.0_dp, s_mos_virt(ispin), gs_mos(ispin)%mos_virt, &
213 0.0_dp, wfm_ao_ao)
214
215 DO ideriv = 1, nderivs
216 CALL cp_fm_create(dipmat_tmp, dip_struct)
217 CALL copy_dbcsr_to_fm(soc_env%dipmat_ao(ideriv)%matrix, dipmat_tmp)
218 CALL parallel_gemm('N', 'T', nao, nao, nao, &
219 1.0_dp, wfm_ao_ao, dipmat_tmp, &
220 0.0_dp, dipole_op_mos_occ(ideriv, ispin))
221 CALL copy_fm_to_dbcsr(dipole_op_mos_occ(ideriv, ispin), soc_env%dipmat(ideriv)%matrix)
222 CALL cp_fm_release(dipmat_tmp)
223 END DO
224 CALL cp_fm_release(wfm_ao_ao)
225 DEALLOCATE (wfm_ao_ao)
226 END DO
227
228 CALL cp_fm_struct_release(dip_struct)
229 DO ispin = 1, nspins
230 CALL cp_fm_release(s_mos_virt(ispin))
231 DO ideriv = 1, nderivs
232 CALL cp_fm_release(dipole_op_mos_occ(ideriv, ispin))
233 END DO
234 END DO
235 DEALLOCATE (s_mos_virt, dipole_op_mos_occ, nmo_virt, dipmat_tmp)
236
237 END SUBROUTINE length_rep
238
239! **************************************************************************************************
240!> \brief ...
241!> \param qs_env ...
242!> \param gs_mos ...
243!> \param soc_env ...
244! **************************************************************************************************
245 SUBROUTINE velocity_rep(qs_env, gs_mos, soc_env)
246 TYPE(qs_environment_type), POINTER :: qs_env
247 TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
248 INTENT(in) :: gs_mos
249 TYPE(soc_env_type), TARGET :: soc_env
250
251 INTEGER :: icol, ideriv, irow, ispin, n_occ, &
252 n_virt, nao, ncols_local, nderivs, &
253 nrows_local, nspins
254 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
255 REAL(kind=dp) :: eval_occ
256 REAL(kind=dp), CONTIGUOUS, DIMENSION(:, :), &
257 POINTER :: local_data_ediff, local_data_wfm
258 TYPE(cp_blacs_env_type), POINTER :: blacs_env
259 TYPE(cp_fm_struct_type), POINTER :: ao_cvirt_struct, ao_nocc_struct, &
260 cvirt_ao_struct, fm_struct, scrm_struct
261 TYPE(cp_fm_type) :: scrm_fm, wfm_mo_virt_mo_occ
262 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, scrm
263 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
264 POINTER :: sab_orb
265 TYPE(qs_ks_env_type), POINTER :: ks_env
266
267 NULLIFY (scrm, scrm_struct, blacs_env, matrix_s, ao_cvirt_struct, ao_nocc_struct, cvirt_ao_struct)
268 nspins = 1
269 nderivs = 3
270 ALLOCATE (soc_env%SC(nspins), soc_env%CdS(nspins, nderivs), soc_env%ediff(nspins))
271
272 CALL get_qs_env(qs_env, ks_env=ks_env, sab_orb=sab_orb, blacs_env=blacs_env, matrix_s=matrix_s)
273 CALL dbcsr_get_info(matrix_s(1)%matrix, nfullrows_total=nao)
274 CALL cp_fm_struct_create(scrm_struct, nrow_global=nao, ncol_global=nao, &
275 context=blacs_env)
276 CALL cp_fm_get_info(gs_mos(1)%mos_virt, matrix_struct=ao_cvirt_struct)
277 CALL cp_fm_get_info(gs_mos(1)%mos_occ, matrix_struct=ao_nocc_struct)
278
279 CALL build_overlap_matrix(ks_env, matrix_s=scrm, nderivative=1, &
280 basis_type_a="ORB", basis_type_b="ORB", &
281 sab_nl=sab_orb)
282
283 DO ispin = 1, nspins
284 NULLIFY (fm_struct)
285 n_occ = SIZE(gs_mos(ispin)%evals_occ)
286 n_virt = SIZE(gs_mos(ispin)%evals_virt)
287 CALL cp_fm_struct_create(fm_struct, nrow_global=n_virt, &
288 ncol_global=n_occ, context=blacs_env)
289 CALL cp_fm_struct_create(cvirt_ao_struct, nrow_global=n_virt, &
290 ncol_global=nao, context=blacs_env)
291 CALL cp_fm_create(soc_env%ediff(ispin), fm_struct)
292 CALL cp_fm_create(wfm_mo_virt_mo_occ, fm_struct)
293 CALL cp_fm_create(soc_env%SC(ispin), ao_cvirt_struct)
294
295 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, &
296 gs_mos(ispin)%mos_virt, &
297 soc_env%SC(ispin), &
298 ncol=n_virt, alpha=1.0_dp, beta=0.0_dp)
299
300 CALL cp_fm_get_info(soc_env%ediff(ispin), nrow_local=nrows_local, ncol_local=ncols_local, &
301 row_indices=row_indices, col_indices=col_indices, local_data=local_data_ediff)
302 CALL cp_fm_get_info(wfm_mo_virt_mo_occ, local_data=local_data_wfm)
303
304!$OMP PARALLEL DO DEFAULT(NONE), &
305!$OMP PRIVATE(eval_occ, icol, irow), &
306!$OMP SHARED(col_indices, gs_mos, ispin, local_data_ediff, ncols_local, nrows_local, row_indices)
307 DO icol = 1, ncols_local
308 ! E_occ_i ; imo_occ = col_indices(icol)
309 eval_occ = gs_mos(ispin)%evals_occ(col_indices(icol))
310
311 DO irow = 1, nrows_local
312 ! ediff_inv_weights(a, i) = 1.0 / (E_virt_a - E_occ_i)
313 ! imo_virt = row_indices(irow)
314 local_data_ediff(irow, icol) = 1.0_dp/(gs_mos(ispin)%evals_virt(row_indices(irow)) - eval_occ)
315 END DO
316 END DO
317!$OMP END PARALLEL DO
318
319 DO ideriv = 1, nderivs
320 CALL cp_fm_create(soc_env%CdS(ispin, ideriv), cvirt_ao_struct)
321 CALL cp_fm_create(scrm_fm, scrm_struct)
322 CALL copy_dbcsr_to_fm(scrm(ideriv + 1)%matrix, scrm_fm)
323 CALL parallel_gemm('T', 'N', n_virt, nao, nao, 1.0_dp, gs_mos(ispin)%mos_virt, &
324 scrm_fm, 0.0_dp, soc_env%CdS(ispin, ideriv))
325 CALL cp_fm_release(scrm_fm)
326
327 END DO
328
329 CALL cp_fm_release(wfm_mo_virt_mo_occ)
330 CALL cp_fm_struct_release(fm_struct)
331 END DO
332 CALL dbcsr_deallocate_matrix_set(scrm)
333 CALL cp_fm_struct_release(scrm_struct)
334 CALL cp_fm_struct_release(cvirt_ao_struct)
335
336 END SUBROUTINE velocity_rep
337
338! **************************************************************************************************
339!> \brief This routine will construct the dipol operator within velocity representation
340!> \param soc_env ..
341!> \param qs_env ...
342!> \param evec_fm ...
343!> \param op ...
344!> \param ideriv ...
345!> \param tp ...
346!> \param gs_coeffs ...
347!> \param sggs_fm ...
348! **************************************************************************************************
349 SUBROUTINE dip_vel_op(soc_env, qs_env, evec_fm, op, ideriv, tp, gs_coeffs, sggs_fm)
350 TYPE(soc_env_type), TARGET :: soc_env
351 TYPE(qs_environment_type), POINTER :: qs_env
352 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(IN) :: evec_fm
353 TYPE(dbcsr_type), INTENT(INOUT) :: op
354 INTEGER, INTENT(IN) :: ideriv
355 LOGICAL, INTENT(IN) :: tp
356 TYPE(cp_fm_type), OPTIONAL, POINTER :: gs_coeffs
357 TYPE(cp_fm_type), INTENT(INOUT), OPTIONAL :: sggs_fm
358
359 INTEGER :: iex, ispin, n_occ, n_virt, nao, nex
360 LOGICAL :: sggs
361 TYPE(cp_blacs_env_type), POINTER :: blacs_env
362 TYPE(cp_fm_struct_type), POINTER :: op_struct, virt_occ_struct
363 TYPE(cp_fm_type) :: cdsc, op_fm, scwcdsc, wcdsc
364 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: wcdsc_tmp
365 TYPE(cp_fm_type), POINTER :: coeff
366 TYPE(mp_para_env_type), POINTER :: para_env
367
368 NULLIFY (virt_occ_struct, virt_occ_struct, op_struct, blacs_env, para_env, coeff)
369
370 IF (tp) THEN
371 coeff => soc_env%b_coeff
372 ELSE
373 coeff => soc_env%a_coeff
374 END IF
375
376 sggs = .false.
377 IF (PRESENT(gs_coeffs)) sggs = .true.
378
379 ispin = 1 !! only rcs availble
380 nex = SIZE(evec_fm, 2)
381 IF (.NOT. sggs) ALLOCATE (wcdsc_tmp(ispin, nex))
382 CALL get_qs_env(qs_env, blacs_env=blacs_env, para_env=para_env)
383 CALL cp_fm_get_info(soc_env%CdS(ispin, ideriv), ncol_global=nao, nrow_global=n_virt)
384 CALL cp_fm_get_info(evec_fm(1, 1), ncol_global=n_occ)
385
386 IF (sggs) THEN
387 CALL cp_fm_struct_create(virt_occ_struct, context=blacs_env, para_env=para_env, nrow_global=n_virt, &
388 ncol_global=n_occ)
389 CALL cp_fm_struct_create(op_struct, context=blacs_env, para_env=para_env, nrow_global=n_occ*nex, &
390 ncol_global=n_occ)
391 ELSE
392 CALL cp_fm_struct_create(virt_occ_struct, context=blacs_env, para_env=para_env, nrow_global=n_virt, &
393 ncol_global=n_occ*nex)
394 CALL cp_fm_struct_create(op_struct, context=blacs_env, para_env=para_env, nrow_global=n_occ*nex, &
395 ncol_global=n_occ*nex)
396 END IF
397
398 CALL cp_fm_create(cdsc, soc_env%ediff(ispin)%matrix_struct)
399 CALL cp_fm_create(op_fm, op_struct)
400
401 IF (sggs) THEN
402 CALL cp_fm_create(scwcdsc, gs_coeffs%matrix_struct)
403 CALL cp_fm_create(wcdsc, soc_env%ediff(ispin)%matrix_struct)
404 CALL parallel_gemm('N', 'N', n_virt, n_occ, nao, 1.0_dp, soc_env%CdS(ispin, ideriv), &
405 gs_coeffs, 0.0_dp, cdsc)
406 CALL cp_fm_schur_product(cdsc, soc_env%ediff(ispin), wcdsc)
407 ELSE
408 CALL cp_fm_create(scwcdsc, coeff%matrix_struct)
409 DO iex = 1, nex
410 CALL cp_fm_create(wcdsc_tmp(ispin, iex), soc_env%ediff(ispin)%matrix_struct)
411 CALL parallel_gemm('N', 'N', n_virt, n_occ, nao, 1.0_dp, soc_env%CdS(ispin, ideriv), &
412 evec_fm(ispin, iex), 0.0_dp, cdsc)
413 CALL cp_fm_schur_product(cdsc, soc_env%ediff(ispin), wcdsc_tmp(ispin, iex))
414 END DO
415 CALL cp_fm_create(wcdsc, virt_occ_struct)
416 CALL soc_contract_evect(wcdsc_tmp, wcdsc)
417 DO iex = 1, nex
418 CALL cp_fm_release(wcdsc_tmp(ispin, iex))
419 END DO
420 DEALLOCATE (wcdsc_tmp)
421 END IF
422
423 IF (sggs) THEN
424 CALL parallel_gemm('N', 'N', nao, n_occ, n_virt, 1.0_dp, soc_env%SC(ispin), wcdsc, 0.0_dp, scwcdsc)
425 CALL parallel_gemm('T', 'N', n_occ*nex, n_occ, nao, 1.0_dp, soc_env%a_coeff, scwcdsc, 0.0_dp, op_fm)
426 ELSE
427 CALL parallel_gemm('N', 'N', nao, n_occ*nex, n_virt, 1.0_dp, soc_env%SC(ispin), wcdsc, 0.0_dp, scwcdsc)
428 CALL parallel_gemm('T', 'N', n_occ*nex, n_occ*nex, nao, 1.0_dp, coeff, scwcdsc, 0.0_dp, op_fm)
429 END IF
430
431 IF (sggs) THEN
432 CALL cp_fm_to_fm(op_fm, sggs_fm)
433 ELSE
434 CALL copy_fm_to_dbcsr(op_fm, op)
435 END IF
436
437 CALL cp_fm_release(op_fm)
438 CALL cp_fm_release(wcdsc)
439 CALL cp_fm_release(scwcdsc)
440 CALL cp_fm_release(cdsc)
441 CALL cp_fm_struct_release(virt_occ_struct)
442 CALL cp_fm_struct_release(op_struct)
443
444 END SUBROUTINE dip_vel_op
445
446! **************************************************************************************************
447!> \brief ...
448!> \param fm_start ...
449!> \param fm_res ...
450! **************************************************************************************************
451 SUBROUTINE soc_contract_evect(fm_start, fm_res)
452
453 TYPE(cp_fm_type), DIMENSION(:, :), INTENT(in) :: fm_start
454 TYPE(cp_fm_type), INTENT(inout) :: fm_res
455
456 CHARACTER(len=*), PARAMETER :: routinen = 'soc_contract_evect'
457
458 INTEGER :: handle, ii, jj, nactive, nao, nspins, &
459 nstates, ntmp1, ntmp2
460
461 CALL timeset(routinen, handle)
462
463 nstates = SIZE(fm_start, 2)
464 nspins = SIZE(fm_start, 1)
465
466 CALL cp_fm_set_all(fm_res, 0.0_dp)
467 !! Evects are written into one matrix.
468 DO ii = 1, nstates
469 DO jj = 1, nspins
470 CALL cp_fm_get_info(fm_start(jj, ii), nrow_global=nao, ncol_global=nactive)
471 CALL cp_fm_get_info(fm_res, nrow_global=ntmp1, ncol_global=ntmp2)
472 CALL cp_fm_to_fm_submat(fm_start(jj, ii), &
473 fm_res, &
474 nao, nactive, &
475 1, 1, 1, &
476 1 + nactive*(ii - 1) + (jj - 1)*nao*nstates)
477 END DO !nspins
478 END DO !nsstates
479
480 CALL timestop(handle)
481
482 END SUBROUTINE soc_contract_evect
483
484! **************************************************************************************************
485!> \brief ...
486!> \param vec ...
487!> \param new_entry ...
488!> \param res ...
489!> \param res_int ...
490! **************************************************************************************************
491 SUBROUTINE test_repetition(vec, new_entry, res, res_int)
492 INTEGER, DIMENSION(:), INTENT(IN) :: vec
493 INTEGER, INTENT(IN) :: new_entry
494 LOGICAL, INTENT(OUT) :: res
495 INTEGER, INTENT(OUT), OPTIONAL :: res_int
496
497 INTEGER :: i
498
499 res = .true.
500 IF (PRESENT(res_int)) res_int = -1
501
502 DO i = 1, SIZE(vec)
503 IF (vec(i) == new_entry) THEN
504 res = .false.
505 IF (PRESENT(res_int)) res_int = i
506 EXIT
507 END IF
508 END DO
509
510 END SUBROUTINE test_repetition
511
512! **************************************************************************************************
513!> \brief Used to find out, which state has which spin-multiplicity
514!> \param evects_cfm ...
515!> \param sort ...
516! **************************************************************************************************
517 SUBROUTINE resort_evects(evects_cfm, sort)
518 TYPE(cp_cfm_type), INTENT(INOUT) :: evects_cfm
519 INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: sort
520
521 COMPLEX(dp), ALLOCATABLE, DIMENSION(:, :) :: cpl_tmp
522 INTEGER :: i_rep, ii, jj, ntot, tmp
523 INTEGER, ALLOCATABLE, DIMENSION(:) :: rep_int
524 LOGICAL :: rep
525 REAL(dp) :: max_dev, max_wfn, wfn_sq
526
527 CALL cp_cfm_get_info(evects_cfm, nrow_global=ntot)
528 ALLOCATE (cpl_tmp(ntot, ntot))
529 ALLOCATE (sort(ntot), rep_int(ntot))
530 cpl_tmp = 0_dp
531 sort = 0
532 max_dev = 0.5
533 CALL cp_cfm_get_submatrix(evects_cfm, cpl_tmp)
534
535 DO jj = 1, ntot
536 rep_int = 0
537 tmp = 0
538 max_wfn = 0_dp
539 DO ii = 1, ntot
540 wfn_sq = abs(real(cpl_tmp(ii, jj)**2 - aimag(cpl_tmp(ii, jj)**2)))
541 IF (max_wfn .LE. wfn_sq) THEN
542 CALL test_repetition(sort, ii, rep, rep_int(ii))
543 IF (rep) THEN
544 max_wfn = wfn_sq
545 tmp = ii
546 END IF
547 END IF
548 END DO
549 IF (tmp > 0) THEN
550 sort(jj) = tmp
551 ELSE
552 DO i_rep = 1, ntot
553 IF (rep_int(i_rep) > 0) THEN
554 max_wfn = abs(real(cpl_tmp(sort(i_rep), jj)**2 - aimag(cpl_tmp(sort(i_rep), jj)**2))) - max_dev
555 DO ii = 1, ntot
556 wfn_sq = abs(real(cpl_tmp(ii, jj)**2 - aimag(cpl_tmp(ii, jj)**2)))
557 IF ((max_wfn - wfn_sq)/max_wfn .LE. max_dev) THEN
558 CALL test_repetition(sort, ii, rep)
559 IF (rep .AND. ii /= i_rep) THEN
560 sort(jj) = sort(i_rep)
561 sort(i_rep) = ii
562 END IF
563 END IF
564 END DO
565 END IF
566 END DO
567 END IF
568 END DO
569
570 DEALLOCATE (cpl_tmp, rep_int)
571
572 END SUBROUTINE resort_evects
573END MODULE qs_tddfpt2_soc_utils
cp_dbcsr_operations::dbcsr_allocate_matrix_set
Definition cp_dbcsr_operations.F:81
cp_dbcsr_operations::dbcsr_deallocate_matrix_set
Definition cp_dbcsr_operations.F:89
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:90
cp_fm_types::cp_fm_to_fm
Definition cp_fm_types.F:85
parallel_gemm_api::parallel_gemm
Definition parallel_gemm_api.F:38
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_cfm_types
Represents a complex full matrix distributed on many processors.
Definition cp_cfm_types.F:12
cp_cfm_types::cp_cfm_get_submatrix
subroutine, public cp_cfm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
Extract a sub-matrix from the full matrix: op(target_m)(1:n_rows,1:n_cols) = fm(start_row:start_row+n...
Definition cp_cfm_types.F:333
cp_cfm_types::cp_cfm_get_info
subroutine, public cp_cfm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, matrix_struct, para_env)
Returns information about a full matrix.
Definition cp_cfm_types.F:607
cp_control_types
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
Definition cp_control_types.F:12
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:744
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:208
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:118
cp_fm_basic_linalg
basic linear algebra operations for full matrices
Definition cp_fm_basic_linalg.F:14
cp_fm_basic_linalg::cp_fm_schur_product
subroutine, public cp_fm_schur_product(matrix_a, matrix_b, matrix_c)
computes the schur product of two matrices c_ij = a_ij * b_ij
Definition cp_fm_basic_linalg.F:728
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:125
cp_fm_struct::cp_fm_struct_release
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
Definition cp_fm_struct.F:320
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:1016
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:1473
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:535
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
Definition cp_fm_types.F:167
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:17
input_constants::tddfpt_dipole_berry
integer, parameter, public tddfpt_dipole_berry
Definition input_constants.F:694
input_constants::tddfpt_dipole_velocity
integer, parameter, public tddfpt_dipole_velocity
Definition input_constants.F:694
input_constants::tddfpt_dipole_length
integer, parameter, public tddfpt_dipole_length
Definition input_constants.F:694
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
moments_utils
Calculates the moment integrals <a|r^m|b>
Definition moments_utils.F:15
moments_utils::get_reference_point
subroutine, public get_reference_point(rpoint, drpoint, qs_env, fist_env, reference, ref_point, ifirst, ilast)
...
Definition moments_utils.F:61
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, 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_nonbond, sab_almo, sab_kp, sab_kp_nosym, 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, ecoul_1c, rho0_s_rs, rho0_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, 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, rhs)
Get the QUICKSTEP environment.
Definition qs_environment_types.F:502
qs_ks_types
Definition qs_ks_types.F:15
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition qs_neighbor_list_types.F:17
qs_operators_ao
Definition qs_operators_ao.F:13
qs_operators_ao::p_xyz_ao
subroutine, public p_xyz_ao(op, qs_env, minimum_image)
Calculation of the components of the dipole operator in the velocity form The elements of the sparse ...
Definition qs_operators_ao.F:818
qs_operators_ao::rrc_xyz_ao
subroutine, public rrc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)
Calculation of the components of the dipole operator in the length form by taking the relative positi...
Definition qs_operators_ao.F:1084
qs_overlap
Calculation of overlap matrix, its derivatives and forces.
Definition qs_overlap.F:19
qs_overlap::build_overlap_matrix
subroutine, public build_overlap_matrix(ks_env, matrix_s, matrixkp_s, matrix_name, nderivative, basis_type_a, basis_type_b, sab_nl, calculate_forces, matrix_p, matrixkp_p)
Calculation of the overlap matrix over Cartesian Gaussian functions.
Definition qs_overlap.F:120
qs_tddfpt2_soc_types
Definition qs_tddfpt2_soc_types.F:7
qs_tddfpt2_soc_utils
Utilities absorption spectroscopy using TDDFPT with SOC.
Definition qs_tddfpt2_soc_utils.F:13
qs_tddfpt2_soc_utils::soc_dipole_operator
subroutine, public soc_dipole_operator(soc_env, tddfpt_control, qs_env, gs_mos)
Build the atomic dipole operator.
Definition qs_tddfpt2_soc_utils.F:91
qs_tddfpt2_soc_utils::resort_evects
subroutine, public resort_evects(evects_cfm, sort)
Used to find out, which state has which spin-multiplicity.
Definition qs_tddfpt2_soc_utils.F:518
qs_tddfpt2_soc_utils::soc_contract_evect
subroutine, public soc_contract_evect(fm_start, fm_res)
...
Definition qs_tddfpt2_soc_utils.F:452
qs_tddfpt2_soc_utils::dip_vel_op
subroutine, public dip_vel_op(soc_env, qs_env, evec_fm, op, ideriv, tp, gs_coeffs, sggs_fm)
This routine will construct the dipol operator within velocity representation.
Definition qs_tddfpt2_soc_utils.F:350
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_cfm_types::cp_cfm_type
Represent a complex full matrix.
Definition cp_cfm_types.F:68
cp_control_types::tddfpt2_control_type
Definition cp_control_types.F:465
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:116
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:763
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:215
qs_ks_types::qs_ks_env_type
calculation environment to calculate the ks matrix, holds all the needed vars. assumes that the core ...
Definition qs_ks_types.F:135
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
qs_tddfpt2_soc_types::soc_env_type
Definition qs_tddfpt2_soc_types.F:49
qs_tddfpt2_types::tddfpt_ground_state_mos
Ground state molecular orbitals.
Definition qs_tddfpt2_types.F:86