28 dbcsr_type_no_symmetry, dbcsr_type_symmetric
83#include "./base/base_uses.f90"
88 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'xas_tdp_utils'
94 TYPE dbcsr_soc_package_type
95 TYPE(dbcsr_type),
POINTER :: dbcsr_sg => null()
96 TYPE(dbcsr_type),
POINTER :: dbcsr_tp => null()
97 TYPE(dbcsr_type),
POINTER :: dbcsr_sc => null()
98 TYPE(dbcsr_type),
POINTER :: dbcsr_sf => null()
99 TYPE(dbcsr_type),
POINTER :: dbcsr_prod => null()
100 TYPE(dbcsr_type),
POINTER :: dbcsr_ovlp => null()
101 TYPE(dbcsr_type),
POINTER :: dbcsr_tmp => null()
102 TYPE(dbcsr_type),
POINTER :: dbcsr_work => null()
103 END TYPE dbcsr_soc_package_type
175 CHARACTER(len=*),
PARAMETER :: routinen =
'setup_xas_tdp_prob'
178 INTEGER,
DIMENSION(:),
POINTER :: submat_blk_size
179 LOGICAL :: do_coul, do_hfx, do_os, do_sc, do_sf, &
180 do_sg, do_tda, do_tp, do_xc
181 REAL(
dp) :: eps_filter, sx
183 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: ex_ker, xc_ker
184 TYPE(
dbcsr_type) :: matrix_a, matrix_a_sf, matrix_b, proj_q, &
186 TYPE(
dbcsr_type),
POINTER :: matrix_c_sc, matrix_c_sf, matrix_c_sg, matrix_c_tp, matrix_d, &
187 matrix_e_sc, sc_matrix_tdp, sf_matrix_tdp, sg_matrix_tdp, tp_matrix_tdp
189 NULLIFY (sg_matrix_tdp, tp_matrix_tdp, submat_dist, submat_blk_size, matrix_c_sf)
190 NULLIFY (matrix_c_sg, matrix_c_tp, matrix_c_sc, matrix_d, matrix_e_sc)
191 NULLIFY (sc_matrix_tdp, sf_matrix_tdp, ex_ker, xc_ker)
193 CALL timeset(routinen, handle)
196 do_os = xas_tdp_control%do_uks .OR. xas_tdp_control%do_roks
197 do_sc = xas_tdp_control%do_spin_cons
198 do_sf = xas_tdp_control%do_spin_flip
199 do_sg = xas_tdp_control%do_singlet
200 do_tp = xas_tdp_control%do_triplet
201 do_xc = xas_tdp_control%do_xc
202 do_hfx = xas_tdp_control%do_hfx
203 do_coul = xas_tdp_control%do_coulomb
204 do_tda = xas_tdp_control%tamm_dancoff
205 sx = xas_tdp_control%sx
206 eps_filter = xas_tdp_control%eps_filter
208 ALLOCATE (donor_state%sc_matrix_tdp)
209 sc_matrix_tdp => donor_state%sc_matrix_tdp
212 ALLOCATE (donor_state%sf_matrix_tdp)
213 sf_matrix_tdp => donor_state%sf_matrix_tdp
216 ALLOCATE (donor_state%sg_matrix_tdp)
217 sg_matrix_tdp => donor_state%sg_matrix_tdp
220 ALLOCATE (donor_state%tp_matrix_tdp)
221 tp_matrix_tdp => donor_state%tp_matrix_tdp
225 CALL compute_submat_dist_and_blk_size(donor_state, do_os, qs_env)
226 submat_dist => donor_state%dbcsr_dist
227 submat_blk_size => donor_state%blk_size
232 IF (do_sg .OR. do_tp .OR. do_sc)
THEN
233 CALL get_q_projector(proj_q, donor_state, do_os, xas_tdp_env)
236 CALL get_q_projector(proj_q_sf, donor_state, do_os, xas_tdp_env, do_sf=.true.)
238 CALL dbcsr_create(matrix=work, matrix_type=dbcsr_type_no_symmetry, dist=submat_dist, &
239 name=
"WORK", row_blk_size=submat_blk_size, col_blk_size=submat_blk_size)
242 IF (do_sg .OR. do_tp .OR. do_sc)
THEN
243 CALL build_gs_contribution(matrix_a, donor_state, do_os, qs_env)
246 CALL build_gs_contribution(matrix_a_sf, donor_state, do_os, qs_env, do_sf=.true.)
251 ALLOCATE (xc_ker(1)%matrix, xc_ker(2)%matrix, xc_ker(3)%matrix, xc_ker(4)%matrix)
252 CALL kernel_coulomb_xc(matrix_b, xc_ker, donor_state, xas_tdp_env, xas_tdp_control, qs_env)
253 matrix_c_sg => xc_ker(1)%matrix; matrix_c_tp => xc_ker(2)%matrix
254 matrix_c_sc => xc_ker(3)%matrix; matrix_c_sf => xc_ker(4)%matrix
258 ALLOCATE (ex_ker(1)%matrix, ex_ker(2)%matrix)
259 CALL kernel_exchange(ex_ker, donor_state, xas_tdp_env, xas_tdp_control, qs_env)
260 matrix_d => ex_ker(1)%matrix; matrix_e_sc => ex_ker(2)%matrix
264 ALLOCATE (donor_state%metric(1))
265 CALL build_metric(donor_state%metric, donor_state, qs_env, do_os)
267 ALLOCATE (donor_state%metric(2))
268 CALL build_metric(donor_state%metric, donor_state, qs_env, do_os, do_inv=.true.)
277 CALL dbcsr_copy(sc_matrix_tdp, matrix_a, name=
"OS MATRIX TDP")
278 IF (do_coul)
CALL dbcsr_add(sc_matrix_tdp, matrix_b, 1.0_dp, 1.0_dp)
280 IF (do_xc)
CALL dbcsr_add(sc_matrix_tdp, matrix_c_sc, 1.0_dp, 1.0_dp)
281 IF (do_hfx)
CALL dbcsr_add(sc_matrix_tdp, matrix_d, 1.0_dp, -1.0_dp*sx)
284 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q, sc_matrix_tdp, 0.0_dp, work, filter_eps=eps_filter)
285 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q, 0.0_dp, sc_matrix_tdp, filter_eps=eps_filter)
292 CALL dbcsr_copy(sf_matrix_tdp, matrix_a_sf, name=
"OS MATRIX TDP")
294 IF (do_xc)
CALL dbcsr_add(sf_matrix_tdp, matrix_c_sf, 1.0_dp, 1.0_dp)
295 IF (do_hfx)
CALL dbcsr_add(sf_matrix_tdp, matrix_d, 1.0_dp, -1.0_dp*sx)
298 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q_sf, sf_matrix_tdp, 0.0_dp, work, filter_eps=eps_filter)
299 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q_sf, 0.0_dp, sf_matrix_tdp, filter_eps=eps_filter)
306 CALL dbcsr_copy(sg_matrix_tdp, matrix_a, name=
"SINGLET MATRIX TDP")
307 IF (do_coul)
CALL dbcsr_add(sg_matrix_tdp, matrix_b, 1.0_dp, 2.0_dp)
309 IF (do_xc)
CALL dbcsr_add(sg_matrix_tdp, matrix_c_sg, 1.0_dp, 1.0_dp)
310 IF (do_hfx)
CALL dbcsr_add(sg_matrix_tdp, matrix_d, 1.0_dp, -1.0_dp*sx)
313 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q, sg_matrix_tdp, 0.0_dp, work, filter_eps=eps_filter)
314 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q, 0.0_dp, sg_matrix_tdp, filter_eps=eps_filter)
321 CALL dbcsr_copy(tp_matrix_tdp, matrix_a, name=
"TRIPLET MATRIX TDP")
323 IF (do_xc)
CALL dbcsr_add(tp_matrix_tdp, matrix_c_tp, 1.0_dp, 1.0_dp)
324 IF (do_hfx)
CALL dbcsr_add(tp_matrix_tdp, matrix_d, 1.0_dp, -1.0_dp*sx)
327 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q, tp_matrix_tdp, 0.0_dp, work, filter_eps=eps_filter)
328 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q, 0.0_dp, tp_matrix_tdp, filter_eps=eps_filter)
336 CALL build_aux_matrix(1.0e-8_dp, sx, matrix_a, matrix_d, matrix_e_sc, do_hfx, proj_q, &
337 work, donor_state, eps_filter, qs_env)
343 CALL dbcsr_copy(sc_matrix_tdp, matrix_a, name=
"OS MATRIX TDP")
344 IF (do_coul)
CALL dbcsr_add(sc_matrix_tdp, matrix_b, 1.0_dp, 2.0_dp)
347 CALL dbcsr_add(sc_matrix_tdp, matrix_d, 1.0_dp, -1.0_dp*sx)
348 CALL dbcsr_add(sc_matrix_tdp, matrix_e_sc, 1.0_dp, -1.0_dp*sx)
351 CALL dbcsr_add(sc_matrix_tdp, matrix_c_sc, 1.0_dp, 2.0_dp)
355 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q, sc_matrix_tdp, 0.0_dp, work, filter_eps=eps_filter)
356 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q, 0.0_dp, sc_matrix_tdp, filter_eps=eps_filter)
360 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, donor_state%metric(2)%matrix, sc_matrix_tdp, &
361 0.0_dp, work, filter_eps=eps_filter)
362 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, work, donor_state%metric(2)%matrix, 0.0_dp, &
363 sc_matrix_tdp, filter_eps=eps_filter)
371 CALL dbcsr_copy(sg_matrix_tdp, matrix_a, name=
"SINGLET MATRIX TDP")
372 IF (do_coul)
CALL dbcsr_add(sg_matrix_tdp, matrix_b, 1.0_dp, 4.0_dp)
375 CALL dbcsr_add(sg_matrix_tdp, matrix_d, 1.0_dp, -1.0_dp*sx)
376 CALL dbcsr_add(sg_matrix_tdp, matrix_e_sc, 1.0_dp, -1.0_dp*sx)
379 CALL dbcsr_add(sg_matrix_tdp, matrix_c_sg, 1.0_dp, 2.0_dp)
383 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q, sg_matrix_tdp, 0.0_dp, work, filter_eps=eps_filter)
384 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q, 0.0_dp, sg_matrix_tdp, filter_eps=eps_filter)
388 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, donor_state%metric(2)%matrix, sg_matrix_tdp, &
389 0.0_dp, work, filter_eps=eps_filter)
390 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, work, donor_state%metric(2)%matrix, 0.0_dp, &
391 sg_matrix_tdp, filter_eps=eps_filter)
399 CALL dbcsr_copy(tp_matrix_tdp, matrix_a, name=
"TRIPLET MATRIX TDP")
402 CALL dbcsr_add(tp_matrix_tdp, matrix_d, 1.0_dp, -1.0_dp*sx)
403 CALL dbcsr_add(tp_matrix_tdp, matrix_e_sc, 1.0_dp, -1.0_dp*sx)
406 CALL dbcsr_add(tp_matrix_tdp, matrix_c_tp, 1.0_dp, 2.0_dp)
410 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q, tp_matrix_tdp, 0.0_dp, work, filter_eps=eps_filter)
411 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q, 0.0_dp, tp_matrix_tdp, filter_eps=eps_filter)
415 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, donor_state%metric(2)%matrix, tp_matrix_tdp, &
416 0.0_dp, work, filter_eps=eps_filter)
417 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, work, donor_state%metric(2)%matrix, 0.0_dp, &
418 tp_matrix_tdp, filter_eps=eps_filter)
434 CALL timestop(handle)
464 INTEGER,
INTENT(IN) :: ex_type
466 CHARACTER(len=*),
PARAMETER :: routinen =
'solve_xas_tdp_prob'
468 INTEGER :: first_ex, handle, i, imo, ispin, nao, &
469 ndo_mo, nelectron, nevals, nocc, nrow, &
471 LOGICAL :: do_os, do_range, do_sf
473 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) :: scaling, tmp_evals
474 REAL(
dp),
DIMENSION(:),
POINTER :: lr_evals
477 TYPE(
cp_fm_type) :: c_diff, c_sum, lhs_matrix, rhs_matrix, &
484 CALL timeset(routinen, handle)
486 NULLIFY (para_env, blacs_env, fm_struct, matrix_tdp)
487 NULLIFY (ex_struct, lr_evals, lr_coeffs)
488 cpassert(
ASSOCIATED(xas_tdp_env))
493 matrix_tdp => donor_state%sc_matrix_tdp
496 matrix_tdp => donor_state%sf_matrix_tdp
500 matrix_tdp => donor_state%sg_matrix_tdp
502 matrix_tdp => donor_state%tp_matrix_tdp
504 CALL get_qs_env(qs_env=qs_env, para_env=para_env, blacs_env=blacs_env, nelectron_total=nelectron)
507 nspins = 1;
IF (do_os) nspins = 2
510 ndo_mo = donor_state%ndo_mo
511 nocc = nelectron/2;
IF (do_os) nocc = nelectron
516 IF (xas_tdp_control%e_range > 0.0_dp) do_range = .true.
520 para_env=para_env, ncol_global=nrow)
525 IF (xas_tdp_control%tamm_dancoff)
THEN
527 IF (xas_tdp_control%do_ot)
THEN
533 ot_elb = xas_tdp_env%lumo_evals(1)%array(1)
534 IF (do_os) ot_elb = min(ot_elb, xas_tdp_env%lumo_evals(2)%array(1))
536 ot_nevals = count(xas_tdp_env%lumo_evals(1)%array - ot_elb .LE. xas_tdp_control%e_range)
537 IF (do_os) ot_nevals = ot_nevals + &
538 count(xas_tdp_env%lumo_evals(2)%array - ot_elb .LE. xas_tdp_control%e_range)
542 ot_nevals = nspins*nao - nocc/ndo_mo
543 IF (xas_tdp_control%n_excited > 0 .AND. xas_tdp_control%n_excited < ot_nevals)
THEN
544 ot_nevals = xas_tdp_control%n_excited
547 ot_nevals = ndo_mo*ot_nevals
551 ALLOCATE (tmp_evals(ot_nevals))
553 nrow_global=nrow, ncol_global=ot_nevals)
556 CALL xas_ot_solver(matrix_tdp, donor_state%metric(1)%matrix, c_sum, tmp_evals, ot_nevals, &
557 do_sf, donor_state, xas_tdp_env, xas_tdp_control, qs_env)
565 ALLOCATE (tmp_evals(nrow))
576 CALL cp_fm_geeig(rhs_matrix, lhs_matrix, c_sum, tmp_evals, work)
587 ALLOCATE (tmp_evals(nrow))
592 CALL dbcsr_create(matrix=tmp_mat, template=matrix_tdp, matrix_type=dbcsr_type_no_symmetry)
593 CALL dbcsr_create(matrix=tmp_mat2, template=matrix_tdp, matrix_type=dbcsr_type_no_symmetry)
594 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, donor_state%matrix_aux, matrix_tdp, &
595 0.0_dp, tmp_mat2, filter_eps=xas_tdp_control%eps_filter)
596 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, tmp_mat2, donor_state%matrix_aux, &
597 0.0_dp, tmp_mat, filter_eps=xas_tdp_control%eps_filter)
607 WHERE (tmp_evals < 1.0e-4_dp) tmp_evals = 0.0_dp
612 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_tdp, donor_state%matrix_aux, &
613 0.0_dp, tmp_mat, filter_eps=xas_tdp_control%eps_filter)
616 ALLOCATE (scaling(nrow))
618 WHERE (abs(tmp_evals) > 1.0e-8_dp) scaling = 1.0_dp/tmp_evals
623 CALL get_normal_scaling(scaling, c_diff, donor_state)
627 tmp_evals = sqrt(tmp_evals)
631 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, donor_state%matrix_aux, donor_state%matrix_aux, &
632 0.0_dp, tmp_mat2, filter_eps=xas_tdp_control%eps_filter)
633 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, donor_state%metric(2)%matrix, tmp_mat2, &
634 0.0_dp, tmp_mat, filter_eps=xas_tdp_control%eps_filter)
636 WHERE (tmp_evals .NE. 0) scaling = -1.0_dp/tmp_evals
653 IF (xas_tdp_control%do_ot)
THEN
657 ELSE IF (do_range)
THEN
659 WHERE (tmp_evals > tmp_evals(first_ex) + xas_tdp_control%e_range) tmp_evals = 0.0_dp
660 nevals = maxloc(tmp_evals, 1) - nocc
665 nevals = nspins*nao - nocc/ndo_mo
666 IF (xas_tdp_control%n_excited > 0 .AND. xas_tdp_control%n_excited < nevals)
THEN
667 nevals = xas_tdp_control%n_excited
669 nevals = ndo_mo*nevals
673 xas_tdp_env%nvirt = nevals
674 ALLOCATE (lr_evals(nevals))
675 lr_evals(:) = tmp_evals(first_ex:first_ex + nevals - 1)
682 para_env=para_env, context=blacs_env)
691 nrow=nao, ncol=1, s_firstrow=((ispin - 1)*ndo_mo + imo - 1)*nao + 1, &
692 s_firstcol=first_ex + i - 1, t_firstrow=1, &
693 t_firstcol=(i - 1)*ndo_mo*nspins + (ispin - 1)*ndo_mo + imo)
699 donor_state%sc_coeffs => lr_coeffs
700 donor_state%sc_evals => lr_evals
702 donor_state%sf_coeffs => lr_coeffs
703 donor_state%sf_evals => lr_evals
705 donor_state%sg_coeffs => lr_coeffs
706 donor_state%sg_evals => lr_evals
708 donor_state%tp_coeffs => lr_coeffs
709 donor_state%tp_evals => lr_evals
720 CALL timestop(handle)
737 SUBROUTINE xas_ot_solver(matrix_tdp, metric, evecs, evals, neig, do_sf, donor_state, xas_tdp_env, &
738 xas_tdp_control, qs_env)
740 TYPE(
dbcsr_type),
POINTER :: matrix_tdp, metric
742 REAL(
dp),
DIMENSION(:) :: evals
743 INTEGER,
INTENT(IN) :: neig
750 CHARACTER(len=*),
PARAMETER :: routinen =
'xas_ot_solver'
752 INTEGER :: handle, max_iter, ndo_mo, nelec_spin(2), &
753 nocc, nrow, output_unit
763 NULLIFY (para_env, blacs_env, ortho_struct, ot_prec)
765 CALL timeset(routinen, handle)
768 IF (output_unit > 0)
THEN
769 WRITE (output_unit,
"(/,T5,A)") &
770 "Using OT eigensolver for diagonalization: "
773 do_os = xas_tdp_control%do_uks .OR. xas_tdp_control%do_roks
774 ndo_mo = donor_state%ndo_mo
775 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env, nelectron_spin=nelec_spin)
777 max_iter = xas_tdp_control%ot_max_iter
778 eps_iter = xas_tdp_control%ot_eps_iter
779 nocc = nelec_spin(1)/2*ndo_mo
780 IF (do_os) nocc = sum(nelec_spin)*ndo_mo
786 nrow_global=nrow, ncol_global=nocc)
789 CALL prep_for_ot(evecs, ortho_space, ot_prec, neig, do_sf, donor_state, xas_tdp_env, &
790 xas_tdp_control, qs_env)
796 precond%dbcsr_matrix => ot_prec
799 CALL ot_eigensolver(matrix_h=matrix_tdp, matrix_s=metric, matrix_c_fm=evecs, &
800 eps_gradient=eps_iter, iter_max=max_iter, silent=.false., &
801 ot_settings=xas_tdp_control%ot_settings, &
802 matrix_orthogonal_space_fm=ortho_space, &
813 CALL timestop(handle)
815 END SUBROUTINE xas_ot_solver
830 SUBROUTINE prep_for_ot(guess, ortho, precond, neig, do_sf, donor_state, xas_tdp_env, &
831 xas_tdp_control, qs_env)
842 CHARACTER(len=*),
PARAMETER :: routinen =
'prep_for_ot'
844 INTEGER :: handle, i, iblk, ido_mo, ispin, jblk, maxel, minel, nao, natom, ndo_mo, &
845 nelec_spin(2), nhomo(2), nlumo(2), nspins, start_block, start_col, start_row
846 LOGICAL :: do_os, found
847 REAL(
dp),
DIMENSION(:, :),
POINTER :: pblock
852 NULLIFY (mos, mo_coeff, pblock)
860 CALL timeset(routinen, handle)
862 do_os = xas_tdp_control%do_uks .OR. xas_tdp_control%do_roks
863 nspins = 1;
IF (do_os) nspins = 2
864 ndo_mo = donor_state%ndo_mo
866 CALL get_qs_env(qs_env, natom=natom, nelectron_spin=nelec_spin)
870 minel = minloc(nelec_spin, 1)
872 nlumo(minel) = (neig/ndo_mo + nelec_spin(maxel) - nelec_spin(minel))/2
873 nlumo(maxel) = neig/ndo_mo - nlumo(minel)
875 nlumo(1) = neig/ndo_mo
884 DO ido_mo = 1, ndo_mo
887 nrow=nao, ncol=nlumo(ispin), s_firstrow=1, s_firstcol=1, &
888 t_firstrow=start_row + 1, t_firstcol=start_col + 1)
890 start_row = start_row + nao
891 start_col = start_col + nlumo(ispin)
901 CALL get_mo_set(mos(ispin), homo=nhomo(ispin))
907 ispin = i;
IF (do_sf) ispin = 3 - i
908 CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff)
910 DO ido_mo = 1, ndo_mo
912 CALL cp_fm_to_fm_submat(msource=mo_coeff, mtarget=ortho, nrow=nao, ncol=nhomo(ispin), &
913 s_firstrow=1, s_firstcol=1, &
914 t_firstrow=start_row + 1, t_firstcol=start_col + 1)
916 start_row = start_row + nao
917 start_col = start_col + nhomo(ispin)
931 CALL dbcsr_get_block_p(xas_tdp_env%ot_prec(ispin)%matrix, iblk, jblk, pblock, found)
935 start_block = (ispin - 1)*ndo_mo*natom
936 DO ido_mo = 1, ndo_mo
937 CALL dbcsr_put_block(precond, start_block + iblk, start_block + jblk, pblock)
939 start_block = start_block + natom
950 CALL timestop(handle)
952 END SUBROUTINE prep_for_ot
962 SUBROUTINE get_normal_scaling(scaling, lr_coeffs, donor_state)
964 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) :: scaling
968 INTEGER :: nrow, nscal, nvals
969 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) ::
diag
975 NULLIFY (para_env, blacs_env, norm_struct, work_struct)
978 CALL cp_fm_get_info(lr_coeffs, context=blacs_env, para_env=para_env, &
979 matrix_struct=work_struct, ncol_global=nvals, nrow_global=nrow)
981 nrow_global=nvals, ncol_global=nvals)
988 CALL parallel_gemm(
'T',
'N', nvals, nvals, nrow, 1.0_dp, lr_coeffs, work, 0.0_dp, fm_norm)
991 ALLOCATE (
diag(nvals))
993 WHERE (abs(
diag) > 1.0e-8_dp)
diag = 1.0_dp/sqrt(abs(
diag))
995 nscal =
SIZE(scaling)
996 scaling(1:nscal) =
diag(1:nscal)
1003 END SUBROUTINE get_normal_scaling
1014 SUBROUTINE compute_submat_dist_and_blk_size(donor_state, do_os, qs_env)
1017 LOGICAL,
INTENT(IN) :: do_os
1020 INTEGER :: group, i, nao, nblk_row, ndo_mo, nspins, &
1021 scol_dist, srow_dist
1022 INTEGER,
DIMENSION(:),
POINTER :: col_dist, col_dist_sub, row_blk_size, &
1023 row_dist, row_dist_sub, submat_blk_size
1024 INTEGER,
DIMENSION(:, :),
POINTER :: pgrid
1028 NULLIFY (matrix_ks, dbcsr_dist, row_blk_size, row_dist, col_dist, pgrid, col_dist_sub)
1029 NULLIFY (row_dist_sub, submat_dist, submat_blk_size)
1036 ndo_mo = donor_state%ndo_mo
1037 CALL get_qs_env(qs_env=qs_env, matrix_ks=matrix_ks, dbcsr_dist=dbcsr_dist)
1038 CALL dbcsr_get_info(matrix_ks(1)%matrix, row_blk_size=row_blk_size)
1041 nao = sum(row_blk_size)
1042 nblk_row =
SIZE(row_blk_size)
1043 srow_dist =
SIZE(row_dist)
1044 scol_dist =
SIZE(col_dist)
1045 nspins = 1;
IF (do_os) nspins = 2
1048 ALLOCATE (submat_blk_size(ndo_mo*nspins*nblk_row))
1049 ALLOCATE (row_dist_sub(ndo_mo*nspins*srow_dist))
1050 ALLOCATE (col_dist_sub(ndo_mo*nspins*scol_dist))
1052 DO i = 1, ndo_mo*nspins
1053 submat_blk_size((i - 1)*nblk_row + 1:i*nblk_row) = row_blk_size
1054 row_dist_sub((i - 1)*srow_dist + 1:i*srow_dist) = row_dist
1055 col_dist_sub((i - 1)*scol_dist + 1:i*scol_dist) = col_dist
1059 ALLOCATE (submat_dist)
1061 col_dist=col_dist_sub)
1063 donor_state%dbcsr_dist => submat_dist
1064 donor_state%blk_size => submat_blk_size
1067 DEALLOCATE (col_dist_sub, row_dist_sub)
1069 END SUBROUTINE compute_submat_dist_and_blk_size
1083 SUBROUTINE get_q_projector(proj_Q, donor_state, do_os, xas_tdp_env, do_sf)
1087 LOGICAL,
INTENT(IN) :: do_os
1089 LOGICAL,
INTENT(IN),
OPTIONAL :: do_sf
1091 CHARACTER(len=*),
PARAMETER :: routinen =
'get_q_projector'
1093 INTEGER :: handle, iblk, imo, ispin, jblk, &
1094 nblk_row, ndo_mo, nspins
1095 INTEGER,
DIMENSION(:),
POINTER :: blk_size_q, row_blk_size
1096 LOGICAL :: found_block, my_dosf
1097 REAL(
dp),
DIMENSION(:, :),
POINTER :: work_block
1102 NULLIFY (work_block, one_sp, row_blk_size, dist_q, blk_size_q)
1104 CALL timeset(routinen, handle)
1107 nspins = 1;
IF (do_os) nspins = 2
1108 ndo_mo = donor_state%ndo_mo
1109 one_sp => xas_tdp_env%q_projector(1)%matrix
1111 nblk_row =
SIZE(row_blk_size)
1113 IF (
PRESENT(do_sf)) my_dosf = do_sf
1114 dist_q => donor_state%dbcsr_dist
1115 blk_size_q => donor_state%blk_size
1118 CALL dbcsr_create(matrix=proj_q, name=
"PROJ Q", matrix_type=dbcsr_type_no_symmetry, dist=dist_q, &
1119 row_blk_size=blk_size_q, col_blk_size=blk_size_q)
1122 DO ispin = 1, nspins
1123 one_sp => xas_tdp_env%q_projector(ispin)%matrix
1126 IF (my_dosf) one_sp => xas_tdp_env%q_projector(3 - ispin)%matrix
1136 IF (found_block)
THEN
1139 CALL dbcsr_put_block(proj_q, ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + iblk, &
1140 ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + jblk, work_block)
1144 NULLIFY (work_block)
1152 CALL timestop(handle)
1154 END SUBROUTINE get_q_projector
1171 SUBROUTINE build_gs_contribution(matrix_a, donor_state, do_os, qs_env, do_sf)
1175 LOGICAL,
INTENT(IN) :: do_os
1177 LOGICAL,
INTENT(IN),
OPTIONAL :: do_sf
1179 CHARACTER(len=*),
PARAMETER :: routinen =
'build_gs_contribution'
1181 INTEGER :: handle, iblk, imo, ispin, jblk, &
1182 nblk_row, ndo_mo, nspins
1183 INTEGER,
DIMENSION(:),
POINTER :: blk_size_a, row_blk_size
1184 LOGICAL :: found_block, my_dosf
1185 REAL(
dp),
DIMENSION(:, :),
POINTER :: work_block
1188 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: m_ks, matrix_ks, matrix_s
1191 NULLIFY (matrix_ks, dbcsr_dist, row_blk_size, work_block, matrix_s, m_ks)
1192 NULLIFY (dist_a, blk_size_a)
1197 CALL timeset(routinen, handle)
1200 nspins = 1;
IF (do_os) nspins = 2
1201 ndo_mo = donor_state%ndo_mo
1202 CALL get_qs_env(qs_env=qs_env, matrix_ks=matrix_ks, matrix_s=matrix_s, dbcsr_dist=dbcsr_dist)
1203 CALL dbcsr_get_info(matrix_s(1)%matrix, row_blk_size=row_blk_size)
1204 nblk_row =
SIZE(row_blk_size)
1205 dist_a => donor_state%dbcsr_dist
1206 blk_size_a => donor_state%blk_size
1209 ALLOCATE (m_ks(nspins))
1210 m_ks(1)%matrix => matrix_ks(1)%matrix
1211 IF (do_os) m_ks(2)%matrix => matrix_ks(2)%matrix
1215 IF (
PRESENT(do_sf)) my_dosf = do_sf
1216 IF (my_dosf .AND. do_os)
THEN
1217 m_ks(1)%matrix => matrix_ks(2)%matrix
1218 m_ks(2)%matrix => matrix_ks(1)%matrix
1222 CALL dbcsr_create(matrix=matrix_a, name=
"MATRIX A", matrix_type=dbcsr_type_symmetric, &
1223 dist=dist_a, row_blk_size=blk_size_a, col_blk_size=blk_size_a)
1224 CALL dbcsr_create(matrix=work_matrix, name=
"WORK MAT", matrix_type=dbcsr_type_symmetric, &
1225 dist=dist_a, row_blk_size=blk_size_a, col_blk_size=blk_size_a)
1227 DO ispin = 1, nspins
1238 IF (found_block)
THEN
1244 CALL dbcsr_put_block(matrix_a, ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + iblk, &
1245 ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + jblk, work_block)
1249 NULLIFY (work_block)
1263 IF (found_block)
THEN
1268 CALL dbcsr_put_block(work_matrix, ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + iblk, &
1269 ((ispin - 1)*ndo_mo + imo - 1)*nblk_row + jblk, &
1270 donor_state%gw2x_evals(imo, ispin)*work_block)
1273 NULLIFY (work_block)
1282 CALL dbcsr_add(matrix_a, work_matrix, 1.0_dp, -1.0_dp)
1289 CALL timestop(handle)
1291 END SUBROUTINE build_gs_contribution
1302 SUBROUTINE build_metric(matrix_g, donor_state, qs_env, do_os, do_inv)
1307 LOGICAL,
INTENT(IN) :: do_os
1308 LOGICAL,
INTENT(IN),
OPTIONAL :: do_inv
1310 CHARACTER(len=*),
PARAMETER :: routinen =
'build_metric'
1312 INTEGER :: handle, i, iblk, jblk, nao, nblk_row, &
1314 INTEGER,
DIMENSION(:),
POINTER :: blk_size_g, row_blk_size
1315 LOGICAL :: found_block, my_do_inv
1316 REAL(
dp),
DIMENSION(:, :),
POINTER :: work_block
1324 NULLIFY (matrix_s, row_blk_size, work_block, para_env, blacs_env, dist_g, blk_size_g)
1326 CALL timeset(routinen, handle)
1329 nspins = 1;
IF (do_os) nspins = 2
1330 ndo_mo = donor_state%ndo_mo
1331 CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s)
1332 CALL dbcsr_get_info(matrix_s(1)%matrix, row_blk_size=row_blk_size, nfullrows_total=nao)
1333 nblk_row =
SIZE(row_blk_size)
1335 IF (
PRESENT(do_inv)) my_do_inv = do_inv
1336 dist_g => donor_state%dbcsr_dist
1337 blk_size_g => donor_state%blk_size
1340 ALLOCATE (matrix_g(1)%matrix)
1341 CALL dbcsr_create(matrix=matrix_g(1)%matrix, name=
"MATRIX G", matrix_type=dbcsr_type_symmetric, &
1342 dist=dist_g, row_blk_size=blk_size_g, col_blk_size=blk_size_g)
1353 IF (found_block)
THEN
1356 DO i = 1, ndo_mo*nspins
1357 CALL dbcsr_put_block(matrix_g(1)%matrix, (i - 1)*nblk_row + iblk, (i - 1)*nblk_row + jblk, work_block)
1361 NULLIFY (work_block)
1372 cpassert(
SIZE(matrix_g) == 2)
1375 ALLOCATE (matrix_g(2)%matrix)
1376 CALL dbcsr_create(matrix=matrix_g(2)%matrix, name=
"MATRIX GINV", &
1377 matrix_type=dbcsr_type_symmetric, dist=dist_g, &
1378 row_blk_size=blk_size_g, col_blk_size=blk_size_g)
1381 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
1382 CALL dbcsr_copy(matrix_sinv, matrix_s(1)%matrix)
1395 IF (found_block)
THEN
1398 DO i = 1, ndo_mo*nspins
1399 CALL dbcsr_put_block(matrix_g(2)%matrix, (i - 1)*nblk_row + iblk, (i - 1)*nblk_row + jblk, work_block)
1403 NULLIFY (work_block)
1415 CALL timestop(handle)
1417 END SUBROUTINE build_metric
1434 SUBROUTINE build_aux_matrix(threshold, sx, matrix_a, matrix_d, matrix_e, do_hfx, proj_Q, &
1435 work, donor_state, eps_filter, qs_env)
1437 REAL(
dp),
INTENT(IN) :: threshold, sx
1438 TYPE(
dbcsr_type),
INTENT(INOUT) :: matrix_a, matrix_d, matrix_e
1439 LOGICAL,
INTENT(IN) :: do_hfx
1440 TYPE(
dbcsr_type),
INTENT(INOUT) :: proj_q, work
1442 REAL(
dp),
INTENT(IN) :: eps_filter
1445 CHARACTER(len=*),
PARAMETER :: routinen =
'build_aux_matrix'
1447 INTEGER :: handle, ndep
1448 REAL(
dp) :: evals(2)
1453 NULLIFY (blacs_env, para_env)
1455 CALL timeset(routinen, handle)
1459 CALL dbcsr_add(tmp_mat, matrix_d, 1.0_dp, -1.0_dp*sx)
1460 CALL dbcsr_add(tmp_mat, matrix_e, 1.0_dp, 1.0_dp*sx)
1464 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, proj_q, tmp_mat, 0.0_dp, work, filter_eps=eps_filter)
1465 CALL dbcsr_multiply(
'N',
'T', 1.0_dp, work, proj_q, 0.0_dp, tmp_mat, filter_eps=eps_filter)
1468 ALLOCATE (donor_state%matrix_aux)
1469 CALL dbcsr_create(matrix=donor_state%matrix_aux, template=matrix_a, name=
"MAT AUX")
1471 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
1474 CALL cp_dbcsr_power(tmp_mat, 0.5_dp, threshold, ndep, para_env, blacs_env, eigenvalues=evals)
1476 CALL dbcsr_copy(donor_state%matrix_aux, tmp_mat)
1479 IF (evals(1) < 0.0_dp .AND. abs(evals(1)) > threshold)
THEN
1480 cpwarn(
"The full TDDFT problem might not have been soundly turned Hermitian. Try TDA.")
1486 CALL timestop(handle)
1488 END SUBROUTINE build_aux_matrix
1510 CHARACTER(len=*),
PARAMETER :: routinen =
'include_os_soc'
1512 INTEGER :: group, handle, homo, iex, isc, isf, nao, &
1513 ndo_mo, ndo_so, nex, npcols, nprows, &
1514 nsc, nsf, ntot, tas(2), tbs(2)
1515 INTEGER,
DIMENSION(:),
POINTER :: col_blk_size, col_dist, row_blk_size, &
1516 row_dist, row_dist_new
1517 INTEGER,
DIMENSION(:, :),
POINTER :: pgrid
1518 LOGICAL :: do_roks, do_uks
1519 REAL(
dp) :: eps_filter, gs_sum, soc
1520 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) ::
diag, tmp_evals
1521 REAL(
dp),
ALLOCATABLE,
DIMENSION(:, :) :: domo_soc_x, domo_soc_y, domo_soc_z, &
1523 REAL(
dp),
DIMENSION(:),
POINTER :: sc_evals, sf_evals
1527 vec_struct, work_struct
1528 TYPE(
cp_fm_type) :: gsex_fm, img_fm, prod_work, real_fm, &
1529 vec_soc_x, vec_soc_y, vec_soc_z, &
1531 TYPE(
cp_fm_type),
POINTER :: gs_coeffs, mo_coeff, sc_coeffs, sf_coeffs
1534 TYPE(dbcsr_soc_package_type) :: dbcsr_soc_package
1535 TYPE(
dbcsr_type),
POINTER :: dbcsr_ovlp, dbcsr_prod, dbcsr_sc, &
1536 dbcsr_sf, dbcsr_tmp, dbcsr_work, &
1537 orb_soc_x, orb_soc_y, orb_soc_z
1541 NULLIFY (gs_coeffs, sc_coeffs, sf_coeffs, matrix_s, orb_soc_x, orb_soc_y, orb_soc_z, mos)
1542 NULLIFY (full_struct, para_env, blacs_env, mo_coeff, sc_evals, sf_evals, vec_struct, prod_struct)
1543 NULLIFY (work_struct, gsex_struct, col_dist, row_dist)
1544 NULLIFY (col_blk_size, row_blk_size, row_dist_new, pgrid, dbcsr_sc, dbcsr_sf, dbcsr_work)
1545 NULLIFY (dbcsr_tmp, dbcsr_ovlp, dbcsr_prod)
1547 CALL timeset(routinen, handle)
1550 sc_coeffs => donor_state%sc_coeffs
1551 sf_coeffs => donor_state%sf_coeffs
1552 sc_evals => donor_state%sc_evals
1553 sf_evals => donor_state%sf_evals
1554 nsc =
SIZE(sc_evals)
1555 nsf =
SIZE(sf_evals)
1556 ntot = 1 + nsc + nsf
1558 ndo_mo = donor_state%ndo_mo
1560 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env, mos=mos, matrix_s=matrix_s)
1562 orb_soc_x => xas_tdp_env%orb_soc(1)%matrix
1563 orb_soc_y => xas_tdp_env%orb_soc(2)%matrix
1564 orb_soc_z => xas_tdp_env%orb_soc(3)%matrix
1565 do_roks = xas_tdp_control%do_roks
1566 do_uks = xas_tdp_control%do_uks
1567 eps_filter = xas_tdp_control%eps_filter
1571 IF (do_uks) gs_coeffs => donor_state%gs_coeffs
1574 nrow_global=nao, ncol_global=ndo_so)
1575 ALLOCATE (gs_coeffs)
1579 CALL cp_fm_to_fm_submat(msource=donor_state%gs_coeffs, mtarget=gs_coeffs, nrow=nao, &
1580 ncol=ndo_mo, s_firstrow=1, s_firstcol=1, t_firstrow=1, &
1582 CALL cp_fm_to_fm_submat(msource=donor_state%gs_coeffs, mtarget=gs_coeffs, nrow=nao, &
1583 ncol=ndo_mo, s_firstrow=1, s_firstcol=1, t_firstrow=1, &
1584 t_firstcol=ndo_mo + 1)
1591 nrow_global=ntot, ncol_global=ntot)
1604 CALL get_qs_env(qs_env, dbcsr_dist=dbcsr_dist)
1606 npcols=npcols, nprows=nprows)
1607 ALLOCATE (col_dist(nex), row_dist_new(nex))
1609 col_dist(iex) =
modulo(npcols - iex, npcols)
1610 row_dist_new(iex) =
modulo(nprows - iex, nprows)
1612 ALLOCATE (coeffs_dist, prod_dist)
1619 ALLOCATE (col_blk_size(nex))
1620 col_blk_size = ndo_so
1621 CALL dbcsr_get_info(matrix_s(1)%matrix, row_blk_size=row_blk_size)
1623 ALLOCATE (dbcsr_sc, dbcsr_sf, dbcsr_work, dbcsr_ovlp, dbcsr_tmp, dbcsr_prod)
1624 CALL dbcsr_create(matrix=dbcsr_sc, name=
"SPIN CONS", matrix_type=dbcsr_type_no_symmetry, &
1625 dist=coeffs_dist, row_blk_size=row_blk_size, col_blk_size=col_blk_size)
1626 CALL dbcsr_create(matrix=dbcsr_sf, name=
"SPIN FLIP", matrix_type=dbcsr_type_no_symmetry, &
1627 dist=coeffs_dist, row_blk_size=row_blk_size, col_blk_size=col_blk_size)
1628 CALL dbcsr_create(matrix=dbcsr_work, name=
"WORK", matrix_type=dbcsr_type_no_symmetry, &
1629 dist=coeffs_dist, row_blk_size=row_blk_size, col_blk_size=col_blk_size)
1630 CALL dbcsr_create(matrix=dbcsr_prod, name=
"PROD", matrix_type=dbcsr_type_no_symmetry, &
1631 dist=prod_dist, row_blk_size=col_blk_size, col_blk_size=col_blk_size)
1632 CALL dbcsr_create(matrix=dbcsr_ovlp, name=
"OVLP", matrix_type=dbcsr_type_no_symmetry, &
1633 dist=prod_dist, row_blk_size=col_blk_size, col_blk_size=col_blk_size)
1636 CALL dbcsr_create(matrix=dbcsr_tmp, name=
"TMP", matrix_type=dbcsr_type_no_symmetry, &
1637 dist=prod_dist, row_blk_size=col_blk_size, col_blk_size=col_blk_size)
1640 dbcsr_soc_package%dbcsr_sc => dbcsr_sc
1641 dbcsr_soc_package%dbcsr_sf => dbcsr_sf
1642 dbcsr_soc_package%dbcsr_work => dbcsr_work
1643 dbcsr_soc_package%dbcsr_ovlp => dbcsr_ovlp
1644 dbcsr_soc_package%dbcsr_prod => dbcsr_prod
1645 dbcsr_soc_package%dbcsr_tmp => dbcsr_tmp
1656 CALL get_mo_set(mos(1), mo_coeff=mo_coeff, homo=homo)
1657 ALLOCATE (
diag(homo))
1660 nrow_global=homo, ncol_global=homo)
1666 CALL parallel_gemm(
'T',
'N', homo, homo, nao, 1.0_dp, mo_coeff, vec_work, 0.0_dp, prod_work)
1674 NULLIFY (vec_struct)
1677 CALL get_mo_set(mos(2), mo_coeff=mo_coeff, homo=homo)
1678 ALLOCATE (
diag(homo))
1681 nrow_global=homo, ncol_global=homo)
1687 CALL parallel_gemm(
'T',
'N', homo, homo, nao, 1.0_dp, mo_coeff, vec_work, 0.0_dp, prod_work)
1689 gs_sum = gs_sum - sum(
diag)
1699 nrow_global=nao, ncol_global=ndo_so)
1701 nrow_global=ndo_so, ncol_global=ndo_so)
1706 ALLOCATE (
diag(ndo_so))
1708 ALLOCATE (domo_soc_x(ndo_so, ndo_so), domo_soc_y(ndo_so, ndo_so), domo_soc_z(ndo_so, ndo_so))
1711 CALL parallel_gemm(
'T',
'N', ndo_so, ndo_so, nao, 1.0_dp, gs_coeffs, vec_soc_x, 0.0_dp, prod_work)
1715 CALL parallel_gemm(
'T',
'N', ndo_so, ndo_so, nao, 1.0_dp, gs_coeffs, vec_soc_y, 0.0_dp, prod_work)
1719 CALL parallel_gemm(
'T',
'N', ndo_so, ndo_so, nao, 1.0_dp, gs_coeffs, vec_soc_z, 0.0_dp, prod_work)
1724 nrow_global=nex, ncol_global=nex)
1733 nrow_global=nex*ndo_so, ncol_global=ndo_so)
1735 ALLOCATE (gsex_block(ndo_so, ndo_so))
1741 CALL parallel_gemm(
'T',
'N', nex*ndo_so, ndo_so, nao, -1.0_dp, sc_coeffs, vec_soc_z, 0.0_dp, gsex_fm)
1744 CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isc - 1)*ndo_so + 1, &
1745 start_col=1, n_rows=ndo_so, n_cols=ndo_so)
1747 soc = sum(
diag(1:ndo_mo)) - sum(
diag(ndo_mo + 1:ndo_so))
1757 CALL parallel_gemm(
'T',
'N', nex*ndo_so, ndo_so, nao, -1.0_dp, sc_coeffs, vec_soc_x, 0.0_dp, gsex_fm)
1760 CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isf - 1)*ndo_so + 1, &
1761 start_col=1, n_rows=ndo_so, n_cols=ndo_so)
1768 CALL parallel_gemm(
'T',
'N', nex*ndo_so, ndo_so, nao, -1.0_dp, sc_coeffs, vec_soc_y, 0.0_dp, gsex_fm)
1771 CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isf - 1)*ndo_so + 1, &
1772 start_col=1, n_rows=ndo_so, n_cols=ndo_so)
1774 soc = sum(
diag(1:ndo_mo))
1775 soc = soc - sum(
diag(ndo_mo + 1:ndo_so))
1788 DEALLOCATE (gsex_block)
1796 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_z, dbcsr_sc, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
1797 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sc, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
1800 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_sc, 0.0_dp, dbcsr_work, &
1801 filter_eps=eps_filter)
1802 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sc, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
1804 CALL os_amew_soc_elements(dbcsr_tmp, dbcsr_prod, dbcsr_ovlp, domo_soc_z, pref_diaga=1.0_dp, &
1805 pref_diagb=-1.0_dp, pref_tracea=-1.0_dp, pref_traceb=1.0_dp, &
1806 pref_diags=gs_sum, symmetric=.true.)
1809 CALL cp_fm_to_fm_submat(msource=work_fm, mtarget=img_fm, nrow=nex, ncol=nex, s_firstrow=1, &
1810 s_firstcol=1, t_firstrow=2, t_firstcol=2)
1818 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_z, dbcsr_sf, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
1819 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sf, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
1822 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_sf, 0.0_dp, &
1823 dbcsr_work, filter_eps=eps_filter)
1824 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sf, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
1828 CALL os_amew_soc_elements(dbcsr_tmp, dbcsr_prod, dbcsr_ovlp, domo_soc_z, pref_diaga=-1.0_dp, &
1829 pref_diagb=1.0_dp, pref_tracea=-1.0_dp, pref_traceb=1.0_dp, &
1830 pref_diags=gs_sum, symmetric=.true.)
1833 CALL cp_fm_to_fm_submat(msource=work_fm, mtarget=img_fm, nrow=nex, ncol=nex, s_firstrow=1, &
1834 s_firstcol=1, t_firstrow=1 + nsc + 1, t_firstcol=1 + nsc + 1)
1840 tas(1) = ndo_mo + 1; tbs(1) = 1
1841 tas(2) = 1; tbs(2) = ndo_mo + 1
1844 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_sf, 0.0_dp, &
1845 dbcsr_work, filter_eps=eps_filter)
1846 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sc, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
1849 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_x, dbcsr_sc, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
1850 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sf, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
1852 CALL os_amew_soc_elements(dbcsr_tmp, dbcsr_prod, dbcsr_ovlp, domo_soc_x, pref_diaga=1.0_dp, &
1853 pref_diagb=1.0_dp, pref_tracea=-1.0_dp, pref_traceb=-1.0_dp, &
1854 tracea_start=tas, traceb_start=tbs)
1857 CALL cp_fm_to_fm_submat(msource=work_fm, mtarget=img_fm, nrow=nex, ncol=nex, s_firstrow=1, &
1858 s_firstcol=1, t_firstrow=2, t_firstcol=1 + nsc + 1)
1861 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_y, dbcsr_sf, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
1862 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sc, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
1864 CALL os_amew_soc_elements(dbcsr_tmp, dbcsr_prod, dbcsr_ovlp, domo_soc_y, pref_diaga=1.0_dp, &
1865 pref_diagb=-1.0_dp, pref_tracea=1.0_dp, pref_traceb=-1.0_dp, &
1866 tracea_start=tas, traceb_start=tbs)
1869 CALL cp_fm_to_fm_submat(msource=work_fm, mtarget=real_fm, nrow=nex, ncol=nex, s_firstrow=1, &
1870 s_firstcol=1, t_firstrow=2, t_firstcol=1 + nsc + 1)
1880 ALLOCATE (tmp_evals(ntot))
1885 ALLOCATE (donor_state%soc_evals(ntot - 1))
1886 donor_state%soc_evals(:) = tmp_evals(2:ntot) - tmp_evals(1)
1889 CALL compute_soc_dipole_fosc(evecs_cfm, dbcsr_soc_package, donor_state, xas_tdp_env, &
1890 xas_tdp_control, qs_env, gs_coeffs=gs_coeffs)
1893 IF (xas_tdp_control%do_quad)
THEN
1894 CALL compute_soc_quadrupole_fosc(evecs_cfm, dbcsr_soc_package, donor_state, xas_tdp_env, &
1895 xas_tdp_control, qs_env, gs_coeffs=gs_coeffs)
1904 DEALLOCATE (gs_coeffs)
1916 DEALLOCATE (coeffs_dist, prod_dist, col_dist, col_blk_size, row_dist_new)
1917 DEALLOCATE (dbcsr_sc, dbcsr_sf, dbcsr_work, dbcsr_prod, dbcsr_ovlp, dbcsr_tmp)
1919 CALL timestop(handle)
1947 CHARACTER(len=*),
PARAMETER :: routinen =
'include_rcs_soc'
1949 INTEGER :: group, handle, iex, isg, itp, nao, &
1950 ndo_mo, nex, npcols, nprows, nsg, &
1952 INTEGER,
DIMENSION(:),
POINTER :: col_blk_size, col_dist, row_blk_size, &
1953 row_dist, row_dist_new
1954 INTEGER,
DIMENSION(:, :),
POINTER :: pgrid
1955 REAL(
dp) :: eps_filter, soc_gst, sqrt2
1956 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) ::
diag, tmp_evals
1957 REAL(
dp),
ALLOCATABLE,
DIMENSION(:, :) :: domo_soc_x, domo_soc_y, domo_soc_z, &
1959 REAL(
dp),
DIMENSION(:),
POINTER :: sg_evals, tp_evals
1963 vec_struct, work_struct
1964 TYPE(
cp_fm_type) :: gstp_fm, img_fm, prod_fm, real_fm, &
1965 tmp_fm, vec_soc_x, vec_soc_y, &
1967 TYPE(
cp_fm_type),
POINTER :: gs_coeffs, sg_coeffs, tp_coeffs
1970 TYPE(dbcsr_soc_package_type) :: dbcsr_soc_package
1971 TYPE(
dbcsr_type),
POINTER :: dbcsr_ovlp, dbcsr_prod, dbcsr_sg, &
1972 dbcsr_tmp, dbcsr_tp, dbcsr_work, &
1973 orb_soc_x, orb_soc_y, orb_soc_z
1976 NULLIFY (sg_coeffs, tp_coeffs, gs_coeffs, sg_evals, tp_evals, full_struct)
1977 NULLIFY (para_env, blacs_env, prod_struct, vec_struct, orb_soc_y, orb_soc_z)
1978 NULLIFY (matrix_s, orb_soc_x)
1979 NULLIFY (work_struct, dbcsr_dist, coeffs_dist, prod_dist, pgrid)
1980 NULLIFY (col_dist, row_dist, col_blk_size, row_blk_size, row_dist_new, gstp_struct)
1981 NULLIFY (dbcsr_tp, dbcsr_sg, dbcsr_prod, dbcsr_work, dbcsr_ovlp, dbcsr_tmp)
1983 CALL timeset(routinen, handle)
1986 cpassert(
ASSOCIATED(xas_tdp_control))
1987 gs_coeffs => donor_state%gs_coeffs
1988 sg_coeffs => donor_state%sg_coeffs
1989 tp_coeffs => donor_state%tp_coeffs
1990 sg_evals => donor_state%sg_evals
1991 tp_evals => donor_state%tp_evals
1992 nsg =
SIZE(sg_evals)
1993 ntp =
SIZE(tp_evals)
1994 ntot = 1 + nsg + 3*ntp
1995 ndo_mo = donor_state%ndo_mo
1998 orb_soc_x => xas_tdp_env%orb_soc(1)%matrix
1999 orb_soc_y => xas_tdp_env%orb_soc(2)%matrix
2000 orb_soc_z => xas_tdp_env%orb_soc(3)%matrix
2002 cpassert(nsg == ntp)
2004 eps_filter = xas_tdp_control%eps_filter
2007 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
2009 nrow_global=ntot, ncol_global=ntot)
2020 CALL cp_fm_set_element(real_fm, 1 + itp + ntp + nsg, 1 + itp + ntp + nsg, tp_evals(itp))
2021 CALL cp_fm_set_element(real_fm, 1 + itp + 2*ntp + nsg, 1 + itp + 2*ntp + nsg, tp_evals(itp))
2025 CALL get_qs_env(qs_env, dbcsr_dist=dbcsr_dist)
2027 npcols=npcols, nprows=nprows)
2028 ALLOCATE (col_dist(nex), row_dist_new(nex))
2030 col_dist(iex) =
modulo(npcols - iex, npcols)
2031 row_dist_new(iex) =
modulo(nprows - iex, nprows)
2033 ALLOCATE (coeffs_dist, prod_dist)
2040 ALLOCATE (col_blk_size(nex))
2041 col_blk_size = ndo_mo
2042 CALL dbcsr_get_info(matrix_s(1)%matrix, row_blk_size=row_blk_size)
2044 ALLOCATE (dbcsr_sg, dbcsr_tp, dbcsr_work, dbcsr_ovlp, dbcsr_tmp, dbcsr_prod)
2045 CALL dbcsr_create(matrix=dbcsr_sg, name=
"SINGLETS", matrix_type=dbcsr_type_no_symmetry, &
2046 dist=coeffs_dist, row_blk_size=row_blk_size, col_blk_size=col_blk_size)
2047 CALL dbcsr_create(matrix=dbcsr_tp, name=
"TRIPLETS", matrix_type=dbcsr_type_no_symmetry, &
2048 dist=coeffs_dist, row_blk_size=row_blk_size, col_blk_size=col_blk_size)
2049 CALL dbcsr_create(matrix=dbcsr_work, name=
"WORK", matrix_type=dbcsr_type_no_symmetry, &
2050 dist=coeffs_dist, row_blk_size=row_blk_size, col_blk_size=col_blk_size)
2051 CALL dbcsr_create(matrix=dbcsr_prod, name=
"PROD", matrix_type=dbcsr_type_no_symmetry, &
2052 dist=prod_dist, row_blk_size=col_blk_size, col_blk_size=col_blk_size)
2053 CALL dbcsr_create(matrix=dbcsr_ovlp, name=
"OVLP", matrix_type=dbcsr_type_no_symmetry, &
2054 dist=prod_dist, row_blk_size=col_blk_size, col_blk_size=col_blk_size)
2057 CALL dbcsr_create(matrix=dbcsr_tmp, name=
"TMP", matrix_type=dbcsr_type_no_symmetry, &
2058 dist=prod_dist, row_blk_size=col_blk_size, col_blk_size=col_blk_size)
2061 dbcsr_soc_package%dbcsr_sg => dbcsr_sg
2062 dbcsr_soc_package%dbcsr_tp => dbcsr_tp
2063 dbcsr_soc_package%dbcsr_work => dbcsr_work
2064 dbcsr_soc_package%dbcsr_ovlp => dbcsr_ovlp
2065 dbcsr_soc_package%dbcsr_prod => dbcsr_prod
2066 dbcsr_soc_package%dbcsr_tmp => dbcsr_tmp
2075 nrow_global=ndo_mo, ncol_global=ndo_mo)
2081 nrow_global=nex, ncol_global=nex)
2084 ALLOCATE (
diag(ndo_mo))
2087 sqrt2 = sqrt(2.0_dp)
2090 ALLOCATE (domo_soc_x(ndo_mo, ndo_mo), domo_soc_y(ndo_mo, ndo_mo), domo_soc_z(ndo_mo, ndo_mo))
2093 CALL parallel_gemm(
'T',
'N', ndo_mo, ndo_mo, nao, 1.0_dp, gs_coeffs, vec_soc_x, 0.0_dp, prod_fm)
2097 CALL parallel_gemm(
'T',
'N', ndo_mo, ndo_mo, nao, 1.0_dp, gs_coeffs, vec_soc_y, 0.0_dp, prod_fm)
2101 CALL parallel_gemm(
'T',
'N', ndo_mo, ndo_mo, nao, 1.0_dp, gs_coeffs, vec_soc_z, 0.0_dp, prod_fm)
2113 nrow_global=ntp*ndo_mo, ncol_global=ndo_mo)
2115 ALLOCATE (gstp_block(ndo_mo, ndo_mo))
2118 CALL parallel_gemm(
'T',
'N', ndo_mo*ntp, ndo_mo, nao, -1.0_dp, tp_coeffs, vec_soc_x, 0.0_dp, gstp_fm)
2121 CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp - 1)*ndo_mo + 1, &
2122 start_col=1, n_rows=ndo_mo, n_cols=ndo_mo)
2130 CALL parallel_gemm(
'T',
'N', ndo_mo*ntp, ndo_mo, nao, -1.0_dp, tp_coeffs, vec_soc_y, 0.0_dp, gstp_fm)
2133 CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp - 1)*ndo_mo + 1, &
2134 start_col=1, n_rows=ndo_mo, n_cols=ndo_mo)
2142 CALL parallel_gemm(
'T',
'N', ndo_mo*ntp, ndo_mo, nao, -1.0_dp, tp_coeffs, vec_soc_z, 0.0_dp, gstp_fm)
2145 CALL cp_fm_get_submatrix(fm=gstp_fm, target_m=gstp_block, start_row=(itp - 1)*ndo_mo + 1, &
2146 start_col=1, n_rows=ndo_mo, n_cols=ndo_mo)
2148 soc_gst = sqrt2*sum(
diag)
2160 DEALLOCATE (gstp_block)
2164 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_tp, 0.0_dp, &
2165 dbcsr_work, filter_eps=eps_filter)
2166 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sg, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
2169 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_x, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2170 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sg, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2173 pref_trace=-1.0_dp, pref_overall=-0.5_dp*sqrt2)
2178 s_firstrow=1, s_firstcol=1, t_firstrow=2, &
2179 t_firstcol=1 + nsg + 1)
2184 s_firstrow=1, s_firstcol=1, t_firstrow=2, &
2185 t_firstcol=1 + nsg + 2*ntp + 1)
2188 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_y, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2189 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sg, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2192 pref_trace=-1.0_dp, pref_overall=-0.5_dp*sqrt2)
2197 s_firstrow=1, s_firstcol=1, t_firstrow=2, &
2198 t_firstcol=1 + nsg + 1)
2202 s_firstrow=1, s_firstcol=1, t_firstrow=2, &
2203 t_firstcol=1 + nsg + 2*ntp + 1)
2206 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_z, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2207 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sg, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2210 pref_trace=-1.0_dp, pref_overall=1.0_dp)
2215 s_firstrow=1, s_firstcol=1, t_firstrow=2, &
2216 t_firstcol=1 + nsg + ntp + 1)
2220 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_tp, 0.0_dp, &
2221 dbcsr_work, filter_eps=eps_filter)
2222 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_tp, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
2225 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_x, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2226 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_tp, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2229 pref_trace=1.0_dp, pref_overall=-0.5_dp*sqrt2)
2234 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + ntp + 1, &
2235 t_firstcol=1 + nsg + 2*ntp + 1)
2241 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, &
2242 t_firstcol=1 + nsg + ntp + 1)
2245 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_y, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2246 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_tp, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2249 pref_trace=1.0_dp, pref_overall=0.5_dp*sqrt2)
2254 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + ntp + 1, &
2255 t_firstcol=1 + nsg + 2*ntp + 1)
2261 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, &
2262 t_firstcol=1 + nsg + ntp + 1)
2265 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, orb_soc_z, dbcsr_tp, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2266 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_tp, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2269 pref_trace=1.0_dp, pref_overall=1.0_dp)
2274 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 2*ntp + 1, &
2275 t_firstcol=1 + nsg + 2*ntp + 1)
2280 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, &
2281 t_firstcol=1 + nsg + 1)
2287 DEALLOCATE (
diag, domo_soc_x, domo_soc_y, domo_soc_z)
2297 ALLOCATE (tmp_evals(ntot))
2302 ALLOCATE (donor_state%soc_evals(ntot - 1))
2303 donor_state%soc_evals(:) = tmp_evals(2:ntot) - tmp_evals(1)
2306 CALL compute_soc_dipole_fosc(evecs_cfm, dbcsr_soc_package, donor_state, xas_tdp_env, &
2307 xas_tdp_control, qs_env)
2310 IF (xas_tdp_control%do_quad)
THEN
2311 CALL compute_soc_quadrupole_fosc(evecs_cfm, dbcsr_soc_package, donor_state, xas_tdp_env, &
2312 xas_tdp_control, qs_env)
2327 DEALLOCATE (coeffs_dist, prod_dist, col_dist, col_blk_size, row_dist_new)
2328 DEALLOCATE (dbcsr_sg, dbcsr_tp, dbcsr_work, dbcsr_prod, dbcsr_ovlp, dbcsr_tmp)
2330 CALL timestop(handle)
2350 SUBROUTINE get_os_amew_op(amew_op, ao_op, gs_coeffs, dbcsr_soc_package, donor_state, &
2353 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:), &
2354 INTENT(OUT) :: amew_op
2357 TYPE(dbcsr_soc_package_type) :: dbcsr_soc_package
2359 REAL(
dp),
INTENT(IN) :: eps_filter
2362 INTEGER :: dim_op, homo, i, isc, nao, ndo_mo, &
2363 ndo_so, nex, nsc, nsf, ntot
2365 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) ::
diag, gsgs_op
2366 REAL(
dp),
ALLOCATABLE,
DIMENSION(:, :) :: domo_op, gsex_block, tmp
2369 tmp_struct, vec_struct
2370 TYPE(
cp_fm_type) :: gsex_fm, prod_work, tmp_fm, vec_work, &
2372 TYPE(
cp_fm_type),
POINTER :: mo_coeff, sc_coeffs, sf_coeffs
2374 TYPE(
dbcsr_type),
POINTER :: ao_op_i, dbcsr_ovlp, dbcsr_prod, &
2375 dbcsr_sc, dbcsr_sf, dbcsr_tmp, &
2380 NULLIFY (matrix_s, para_env, blacs_env, full_struct, vec_struct, prod_struct, mos)
2381 NULLIFY (mo_coeff, ao_op_i, tmp_struct)
2382 NULLIFY (dbcsr_sc, dbcsr_sf, dbcsr_ovlp, dbcsr_work, dbcsr_tmp, dbcsr_prod)
2385 dim_op =
SIZE(ao_op)
2386 sc_coeffs => donor_state%sc_coeffs
2387 sf_coeffs => donor_state%sf_coeffs
2388 nsc =
SIZE(donor_state%sc_evals)
2389 nsf =
SIZE(donor_state%sf_evals)
2391 ntot = 1 + nsc + nsf
2392 ndo_mo = donor_state%ndo_mo
2393 ndo_so = 2*donor_state%ndo_mo
2394 CALL get_qs_env(qs_env, matrix_s=matrix_s, para_env=para_env, blacs_env=blacs_env, mos=mos)
2397 dbcsr_sc => dbcsr_soc_package%dbcsr_sc
2398 dbcsr_sf => dbcsr_soc_package%dbcsr_sf
2399 dbcsr_work => dbcsr_soc_package%dbcsr_work
2400 dbcsr_tmp => dbcsr_soc_package%dbcsr_tmp
2401 dbcsr_prod => dbcsr_soc_package%dbcsr_prod
2402 dbcsr_ovlp => dbcsr_soc_package%dbcsr_ovlp
2406 nrow_global=ntot, ncol_global=ntot)
2407 ALLOCATE (amew_op(dim_op))
2414 ALLOCATE (gsgs_op(dim_op))
2417 CALL get_mo_set(mos(1), mo_coeff=mo_coeff, homo=homo)
2418 ALLOCATE (
diag(homo))
2421 nrow_global=homo, ncol_global=homo)
2427 ao_op_i => ao_op(i)%matrix
2430 CALL parallel_gemm(
'T',
'N', homo, homo, nao, 1.0_dp, mo_coeff, vec_work, 0.0_dp, prod_work)
2432 gsgs_op(i) = sum(
diag)
2440 NULLIFY (vec_struct)
2443 CALL get_mo_set(mos(2), mo_coeff=mo_coeff, homo=homo)
2444 ALLOCATE (
diag(homo))
2447 nrow_global=homo, ncol_global=homo)
2453 ao_op_i => ao_op(i)%matrix
2456 CALL parallel_gemm(
'T',
'N', homo, homo, nao, 1.0_dp, mo_coeff, vec_work, 0.0_dp, prod_work)
2458 gsgs_op(i) = gsgs_op(i) + sum(
diag)
2466 NULLIFY (vec_struct)
2470 nrow_global=nao, ncol_global=ndo_so)
2472 nrow_global=ndo_so, ncol_global=ndo_so)
2474 nrow_global=ndo_so*nex, ncol_global=ndo_so)
2476 nrow_global=nex, ncol_global=nex)
2482 ALLOCATE (
diag(ndo_so))
2483 ALLOCATE (domo_op(ndo_so, ndo_so))
2484 ALLOCATE (tmp(ndo_so, ndo_so))
2485 ALLOCATE (gsex_block(ndo_so, ndo_so))
2490 ao_op_i => ao_op(i)%matrix
2498 CALL parallel_gemm(
'T',
'N', ndo_so, ndo_so, nao, 1.0_dp, gs_coeffs, vec_work, 0.0_dp, prod_work)
2502 CALL parallel_gemm(
'T',
'N', ndo_so*nsc, ndo_so, nao, 1.0_dp, sc_coeffs, vec_work, 0.0_dp, gsex_fm)
2504 CALL cp_fm_get_submatrix(fm=gsex_fm, target_m=gsex_block, start_row=(isc - 1)*ndo_so + 1, &
2505 start_col=1, n_rows=ndo_so, n_cols=ndo_so)
2513 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_sc, 0.0_dp, &
2514 dbcsr_work, filter_eps=eps_filter)
2515 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sc, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
2518 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, ao_op_i, dbcsr_sc, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2519 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sc, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2521 CALL os_amew_soc_elements(dbcsr_tmp, dbcsr_prod, dbcsr_ovlp, domo_op, pref_diaga=1.0_dp, &
2522 pref_diagb=1.0_dp, pref_tracea=-1.0_dp, pref_traceb=-1.0_dp, &
2523 pref_diags=gsgs_op(i), symmetric=.true.)
2527 s_firstrow=1, s_firstcol=1, t_firstrow=2, t_firstcol=2)
2531 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_sf, 0.0_dp, &
2532 dbcsr_work, filter_eps=eps_filter)
2533 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sf, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
2536 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, ao_op_i, dbcsr_sf, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2537 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sf, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2540 tmp(1:ndo_mo, 1:ndo_mo) = domo_op(ndo_mo + 1:ndo_so, ndo_mo + 1:ndo_so)
2541 tmp(ndo_mo + 1:ndo_so, ndo_mo + 1:ndo_so) = domo_op(1:ndo_mo, 1:ndo_mo)
2543 CALL os_amew_soc_elements(dbcsr_tmp, dbcsr_prod, dbcsr_ovlp, tmp, pref_diaga=1.0_dp, &
2544 pref_diagb=1.0_dp, pref_tracea=-1.0_dp, pref_traceb=-1.0_dp, &
2545 pref_diags=gsgs_op(i), symmetric=.true.)
2549 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsc + 1, t_firstcol=1 + nsc + 1)
2568 END SUBROUTINE get_os_amew_op
2584 SUBROUTINE get_rcs_amew_op(amew_op, ao_op, dbcsr_soc_package, donor_state, eps_filter, qs_env)
2586 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:), &
2587 INTENT(OUT) :: amew_op
2589 TYPE(dbcsr_soc_package_type) :: dbcsr_soc_package
2591 REAL(
dp),
INTENT(IN) :: eps_filter
2594 INTEGER :: dim_op, homo, i, isg, nao, ndo_mo, nex, &
2596 REAL(
dp) :: op, sqrt2
2597 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) ::
diag, gs_diag, gsgs_op
2598 REAL(
dp),
ALLOCATABLE,
DIMENSION(:, :) :: domo_op, sggs_block
2601 sggs_struct, std_struct, tmp_struct, &
2603 TYPE(
cp_fm_type) :: gs_fm, prod_fm, sggs_fm, tmp_fm, vec_op, &
2605 TYPE(
cp_fm_type),
POINTER :: gs_coeffs, mo_coeff, sg_coeffs
2607 TYPE(
dbcsr_type),
POINTER :: ao_op_i, dbcsr_ovlp, dbcsr_prod, &
2608 dbcsr_sg, dbcsr_tmp, dbcsr_tp, &
2613 NULLIFY (gs_coeffs, sg_coeffs, matrix_s, full_struct, prod_struct, vec_struct, blacs_env)
2614 NULLIFY (para_env, mo_coeff, mos, gsgs_struct, std_struct, tmp_struct, sggs_struct)
2615 NULLIFY (ao_op_i, dbcsr_tp, dbcsr_sg, dbcsr_ovlp, dbcsr_work, dbcsr_tmp, dbcsr_prod)
2618 gs_coeffs => donor_state%gs_coeffs
2619 sg_coeffs => donor_state%sg_coeffs
2620 nsg =
SIZE(donor_state%sg_evals)
2621 ntp = nsg; nex = nsg
2622 ntot = 1 + nsg + 3*ntp
2623 ndo_mo = donor_state%ndo_mo
2624 CALL get_qs_env(qs_env, matrix_s=matrix_s, para_env=para_env, blacs_env=blacs_env, mos=mos)
2625 sqrt2 = sqrt(2.0_dp)
2626 dim_op =
SIZE(ao_op)
2628 dbcsr_sg => dbcsr_soc_package%dbcsr_sg
2629 dbcsr_tp => dbcsr_soc_package%dbcsr_tp
2630 dbcsr_work => dbcsr_soc_package%dbcsr_work
2631 dbcsr_prod => dbcsr_soc_package%dbcsr_prod
2632 dbcsr_ovlp => dbcsr_soc_package%dbcsr_ovlp
2633 dbcsr_tmp => dbcsr_soc_package%dbcsr_tmp
2637 nrow_global=ntot, ncol_global=ntot)
2638 ALLOCATE (amew_op(dim_op))
2644 CALL get_mo_set(mos(1), mo_coeff=mo_coeff, nao=nao, homo=homo)
2646 nrow_global=homo, ncol_global=homo)
2650 ALLOCATE (gsgs_op(dim_op))
2651 ALLOCATE (gs_diag(homo))
2655 ao_op_i => ao_op(i)%matrix
2658 CALL parallel_gemm(
'T',
'N', homo, homo, nao, 1.0_dp, mo_coeff, work_fm, 0.0_dp, gs_fm)
2660 gsgs_op(i) = 2.0_dp*sum(gs_diag)
2667 DEALLOCATE (gs_diag)
2672 nrow_global=ndo_mo, ncol_global=ndo_mo)
2676 nrow_global=nex, ncol_global=nex)
2678 nrow_global=ndo_mo*nsg, ncol_global=ndo_mo)
2682 ALLOCATE (
diag(ndo_mo))
2683 ALLOCATE (domo_op(ndo_mo, ndo_mo))
2684 ALLOCATE (sggs_block(ndo_mo, ndo_mo))
2690 ao_op_i => ao_op(i)%matrix
2697 CALL parallel_gemm(
'T',
'N', ndo_mo, ndo_mo, nao, 1.0_dp, gs_coeffs, vec_op, 0.0_dp, prod_fm)
2701 CALL parallel_gemm(
'T',
'N', ndo_mo*nsg, ndo_mo, nao, 1.0_dp, sg_coeffs, vec_op, 0.0_dp, sggs_fm)
2703 CALL cp_fm_get_submatrix(fm=sggs_fm, target_m=sggs_block, start_row=(isg - 1)*ndo_mo + 1, &
2704 start_col=1, n_rows=ndo_mo, n_cols=ndo_mo)
2706 op = sqrt2*sum(
diag)
2712 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_sg, 0.0_dp, &
2713 dbcsr_work, filter_eps=eps_filter)
2714 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sg, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
2717 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, ao_op_i, dbcsr_sg, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2718 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sg, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2722 pref_overall=1.0_dp, pref_diags=gsgs_op(i), symmetric=.true.)
2726 s_firstrow=1, s_firstcol=1, t_firstrow=2, t_firstcol=2)
2730 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, matrix_s(1)%matrix, dbcsr_tp, 0.0_dp, &
2731 dbcsr_work, filter_eps=eps_filter)
2732 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_tp, dbcsr_work, 0.0_dp, dbcsr_ovlp, filter_eps=eps_filter)
2735 CALL dbcsr_multiply(
'N',
'N', 1.0_dp, ao_op_i, dbcsr_sg, 0.0_dp, dbcsr_work, filter_eps=eps_filter)
2736 CALL dbcsr_multiply(
'T',
'N', 1.0_dp, dbcsr_sg, dbcsr_work, 0.0_dp, dbcsr_prod, filter_eps=eps_filter)
2739 pref_overall=1.0_dp, pref_diags=gsgs_op(i), symmetric=.true.)
2744 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 1, t_firstcol=1 + nsg + 1)
2747 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + ntp + 1, &
2748 t_firstcol=1 + nsg + ntp + 1)
2751 s_firstrow=1, s_firstcol=1, t_firstrow=1 + nsg + 2*ntp + 1, &
2752 t_firstcol=1 + nsg + 2*ntp + 1)
2770 END SUBROUTINE get_rcs_amew_op
2793 SUBROUTINE os_amew_soc_elements(amew_soc, lr_soc, lr_overlap, domo_soc, pref_diaga, &
2794 pref_diagb, pref_tracea, pref_traceb, pref_diags, &
2795 symmetric, tracea_start, traceb_start)
2797 TYPE(
dbcsr_type) :: amew_soc, lr_soc, lr_overlap
2798 REAL(
dp),
DIMENSION(:, :) :: domo_soc
2799 REAL(
dp) :: pref_diaga, pref_diagb, pref_tracea, &
2801 REAL(
dp),
OPTIONAL :: pref_diags
2802 LOGICAL,
OPTIONAL :: symmetric
2803 INTEGER,
DIMENSION(2),
OPTIONAL :: tracea_start, traceb_start
2805 INTEGER :: iex, jex, ndo_mo, ndo_so
2806 INTEGER,
DIMENSION(2) :: tas, tbs
2807 LOGICAL :: do_diags, found, my_symm
2808 REAL(
dp) :: soc_elem
2809 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) ::
diag
2810 REAL(
dp),
DIMENSION(:, :),
POINTER :: pblock
2813 ndo_so =
SIZE(domo_soc, 1)
2815 ALLOCATE (
diag(ndo_so))
2817 IF (
PRESENT(symmetric)) my_symm = symmetric
2819 IF (
PRESENT(pref_diags)) do_diags = .true.
2827 IF (
PRESENT(tracea_start)) tas = tracea_start
2828 IF (
PRESENT(traceb_start)) tbs = traceb_start
2837 IF (my_symm .AND. iex > jex) cycle
2844 soc_elem = soc_elem + pref_diaga*sum(
diag(1:ndo_mo)) + pref_diagb*(sum(
diag(ndo_mo + 1:ndo_so)))
2849 soc_elem = soc_elem &
2850 + pref_tracea*sum(pblock(tas(1):tas(1) + ndo_mo - 1, tas(2):tas(2) + ndo_mo - 1)* &
2851 domo_soc(tas(1):tas(1) + ndo_mo - 1, tas(2):tas(2) + ndo_mo - 1)) &
2852 + pref_traceb*sum(pblock(tbs(1):tbs(1) + ndo_mo - 1, tbs(2):tbs(2) + ndo_mo - 1)* &
2853 domo_soc(tbs(1):tbs(1) + ndo_mo - 1, tbs(2):tbs(2) + ndo_mo - 1))
2857 soc_elem = soc_elem + pref_diags*sum(
diag)
2867 END SUBROUTINE os_amew_soc_elements
2884 pref_overall, pref_diags, symmetric)
2886 TYPE(
dbcsr_type) :: amew_soc, lr_soc, lr_overlap
2887 REAL(
dp),
DIMENSION(:, :) :: domo_soc
2888 REAL(
dp) :: pref_trace, pref_overall
2889 REAL(
dp),
OPTIONAL :: pref_diags
2890 LOGICAL,
OPTIONAL :: symmetric
2893 LOGICAL :: do_diags, found, my_symm
2894 REAL(
dp) :: soc_elem
2895 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) ::
diag
2896 REAL(
dp),
DIMENSION(:, :),
POINTER :: pblock
2899 ALLOCATE (
diag(
SIZE(domo_soc, 1)))
2901 IF (
PRESENT(symmetric)) my_symm = symmetric
2903 IF (
PRESENT(pref_diags)) do_diags = .true.
2912 IF (my_symm .AND. iex > jex) cycle
2919 soc_elem = soc_elem + sum(
diag)
2924 soc_elem = soc_elem + pref_trace*sum(pblock*transpose(domo_soc))
2928 soc_elem = soc_elem + pref_diags*sum(
diag)
2933 pblock = pref_overall*soc_elem
2951 SUBROUTINE compute_soc_dipole_fosc(soc_evecs_cfm, dbcsr_soc_package, donor_state, xas_tdp_env, &
2952 xas_tdp_control, qs_env, gs_coeffs)
2955 TYPE(dbcsr_soc_package_type) :: dbcsr_soc_package
2960 TYPE(
cp_fm_type),
INTENT(IN),
OPTIONAL :: gs_coeffs
2962 CHARACTER(len=*),
PARAMETER :: routinen =
'compute_soc_dipole_fosc'
2964 COMPLEX(dp),
ALLOCATABLE,
DIMENSION(:, :) :: transdip
2965 INTEGER :: handle, i, nosc, ntot
2966 LOGICAL :: do_os, do_rcs
2967 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) :: osc_xyz
2968 REAL(
dp),
DIMENSION(:),
POINTER :: soc_evals
2969 REAL(
dp),
DIMENSION(:, :),
POINTER :: osc_str
2971 TYPE(
cp_cfm_type) :: dip_cfm, work1_cfm, work2_cfm
2973 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: amew_dip
2976 NULLIFY (para_env, blacs_env, dip_struct, full_struct, osc_str)
2979 CALL timeset(routinen, handle)
2982 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
2983 do_os = xas_tdp_control%do_spin_cons
2984 do_rcs = xas_tdp_control%do_singlet
2985 soc_evals => donor_state%soc_evals
2986 nosc =
SIZE(soc_evals)
2988 ALLOCATE (donor_state%soc_osc_str(nosc, 4))
2989 osc_str => donor_state%soc_osc_str
2990 osc_str(:, :) = 0.0_dp
2991 IF (do_os .AND. .NOT.
PRESENT(gs_coeffs)) cpabort(
"Need to pass gs_coeffs for open-shell")
2995 nrow_global=ntot, ncol_global=1)
3000 ALLOCATE (transdip(ntot, 1))
3004 CALL get_os_amew_op(amew_dip, xas_tdp_env%dipmat, gs_coeffs, dbcsr_soc_package, &
3005 donor_state, xas_tdp_control%eps_filter, qs_env)
3007 CALL get_rcs_amew_op(amew_dip, xas_tdp_env%dipmat, dbcsr_soc_package, donor_state, &
3008 xas_tdp_control%eps_filter, qs_env)
3011 ALLOCATE (osc_xyz(nosc))
3015 CALL cp_fm_to_cfm(msourcer=amew_dip(i), mtarget=work1_cfm)
3018 CALL parallel_gemm(
'C',
'N', ntot, ntot, ntot, (1.0_dp, 0.0_dp), soc_evecs_cfm, work1_cfm, &
3019 (0.0_dp, 0.0_dp), work2_cfm)
3020 CALL parallel_gemm(
'N',
'N', ntot, 1, ntot, (1.0_dp, 0.0_dp), work2_cfm, soc_evecs_cfm, &
3021 (0.0_dp, 0.0_dp), dip_cfm)
3026 osc_xyz(:) = real(transdip(2:ntot, 1))**2 + aimag(transdip(2:ntot, 1))**2
3027 osc_str(:, 4) = osc_str(:, 4) + osc_xyz(:)
3028 osc_str(:, i) = osc_xyz(:)
3034 IF (xas_tdp_control%dipole_form ==
xas_dip_len)
THEN
3035 osc_str(:, i) = 2.0_dp/3.0_dp*soc_evals(:)*osc_str(:, i)
3037 osc_str(:, i) = 2.0_dp/3.0_dp/soc_evals(:)*osc_str(:, i)
3049 DEALLOCATE (amew_dip, transdip)
3051 CALL timestop(handle)
3053 END SUBROUTINE compute_soc_dipole_fosc
3066 SUBROUTINE compute_soc_quadrupole_fosc(soc_evecs_cfm, dbcsr_soc_package, donor_state, &
3067 xas_tdp_env, xas_tdp_control, qs_env, gs_coeffs)
3070 TYPE(dbcsr_soc_package_type) :: dbcsr_soc_package
3075 TYPE(
cp_fm_type),
INTENT(IN),
OPTIONAL :: gs_coeffs
3077 CHARACTER(len=*),
PARAMETER :: routinen =
'compute_soc_quadrupole_fosc'
3079 COMPLEX(dp),
ALLOCATABLE,
DIMENSION(:) :: trace
3080 COMPLEX(dp),
ALLOCATABLE,
DIMENSION(:, :) :: transquad
3081 INTEGER :: handle, i, nosc, ntot
3082 LOGICAL :: do_os, do_rcs
3083 REAL(
dp),
DIMENSION(:),
POINTER :: osc_str, soc_evals
3085 TYPE(
cp_cfm_type) :: quad_cfm, work1_cfm, work2_cfm
3087 TYPE(
cp_fm_type),
ALLOCATABLE,
DIMENSION(:) :: amew_quad
3090 NULLIFY (para_env, blacs_env, quad_struct, full_struct, osc_str)
3093 CALL timeset(routinen, handle)
3096 CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
3097 do_os = xas_tdp_control%do_spin_cons
3098 do_rcs = xas_tdp_control%do_singlet
3099 soc_evals => donor_state%soc_evals
3100 nosc =
SIZE(soc_evals)
3102 ALLOCATE (donor_state%soc_quad_osc_str(nosc))
3103 osc_str => donor_state%soc_quad_osc_str
3105 IF (do_os .AND. .NOT.
PRESENT(gs_coeffs)) cpabort(
"Need to pass gs_coeffs for open-shell")
3109 nrow_global=ntot, ncol_global=1)
3114 ALLOCATE (transquad(ntot, 1))
3115 ALLOCATE (trace(nosc))
3116 trace = (0.0_dp, 0.0_dp)
3120 CALL get_os_amew_op(amew_quad, xas_tdp_env%quadmat, gs_coeffs, dbcsr_soc_package, &
3121 donor_state, xas_tdp_control%eps_filter, qs_env)
3123 CALL get_rcs_amew_op(amew_quad, xas_tdp_env%quadmat, dbcsr_soc_package, donor_state, &
3124 xas_tdp_control%eps_filter, qs_env)
3130 CALL cp_fm_to_cfm(msourcer=amew_quad(i), mtarget=work1_cfm)
3133 CALL parallel_gemm(
'C',
'N', ntot, ntot, ntot, (1.0_dp, 0.0_dp), soc_evecs_cfm, work1_cfm, &
3134 (0.0_dp, 0.0_dp), work2_cfm)
3135 CALL parallel_gemm(
'N',
'N', ntot, 1, ntot, (1.0_dp, 0.0_dp), work2_cfm, soc_evecs_cfm, &
3136 (0.0_dp, 0.0_dp), quad_cfm)
3141 IF (i == 1 .OR. i == 4 .OR. i == 6)
THEN
3142 osc_str(:) = osc_str(:) + real(transquad(2:ntot, 1))**2 + aimag(transquad(2:ntot, 1))**2
3143 trace(:) = trace(:) + transquad(2:ntot, 1)
3147 osc_str(:) = osc_str(:) + 2.0_dp*(real(transquad(2:ntot, 1))**2 + aimag(transquad(2:ntot, 1))**2)
3153 osc_str(:) = osc_str(:) - 1._dp/3._dp*(real(trace(:))**2 + aimag(trace(:))**2)
3156 osc_str(:) = osc_str(:)*1._dp/20._dp*
a_fine**2*soc_evals(:)**3
3164 DEALLOCATE (transquad, trace)
3166 CALL timestop(handle)
3168 END SUBROUTINE compute_soc_quadrupole_fosc
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
methods related to the blacs parallel environment
used for collecting diagonalization schemes available for cp_cfm_type
subroutine, public cp_cfm_heevd(matrix, eigenvectors, eigenvalues)
Perform a diagonalisation of a complex matrix.
Represents a complex full matrix distributed on many processors.
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...
subroutine, public cp_cfm_create(matrix, matrix_struct, name)
Creates a new full matrix with the given structure.
subroutine, public cp_cfm_release(matrix)
Releases a full matrix.
subroutine, public cp_fm_to_cfm(msourcer, msourcei, mtarget)
Construct a complex full matrix by taking its real and imaginary parts from two separate real-value f...
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.
subroutine, public dbcsr_distribution_release(dist)
...
subroutine, public dbcsr_distribution_new(dist, template, group, pgrid, row_dist, col_dist, reuse_arrays)
...
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset)
...
logical function, public dbcsr_iterator_blocks_left(iterator)
...
subroutine, public dbcsr_iterator_stop(iterator)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
subroutine, public dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, first_row, last_row, first_column, last_column, first_k, last_k, retain_sparsity, filter_eps, flop)
...
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
subroutine, public dbcsr_finalize(matrix)
...
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_release(matrix)
...
subroutine, public dbcsr_put_block(matrix, row, col, block, summation)
...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
subroutine, public dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, subgroups_defined, prow_group, pcol_group)
...
Interface to (sca)lapack for the Cholesky based procedures.
subroutine, public cp_dbcsr_cholesky_decompose(matrix, n, para_env, blacs_env)
used to replace a symmetric positive def. matrix M with its cholesky decomposition U: M = U^T * U,...
subroutine, public cp_dbcsr_cholesky_invert(matrix, n, para_env, blacs_env, uplo_to_full)
used to replace the cholesky decomposition by the inverse
subroutine, public dbcsr_reserve_all_blocks(matrix)
Reserves all blocks.
Interface to (sca)lapack for the Cholesky based procedures.
subroutine, public cp_dbcsr_power(matrix, exponent, threshold, n_dependent, para_env, blacs_env, verbose, eigenvectors, eigenvalues)
...
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_column_scale(matrixa, scaling)
scales column i of matrix a with scaling(i)
subroutine, public cp_fm_transpose(matrix, matrixt)
transposes a matrix matrixt = matrix ^ T
subroutine, public cp_fm_uplo_to_full(matrix, work, uplo)
given a triangular matrix according to uplo, computes the corresponding full matrix
subroutine, public cp_fm_scale(alpha, matrix_a)
scales a matrix matrix_a = alpha * matrix_b
used for collecting some of the diagonalization schemes available for cp_fm_type. cp_fm_power also mo...
subroutine, public cp_fm_geeig(amatrix, bmatrix, eigenvectors, eigenvalues, work)
General Eigenvalue Problem AX = BXE Single option version: Cholesky decomposition of B.
subroutine, public choose_eigv_solver(matrix, eigenvectors, eigenvalues, info)
Choose the Eigensolver depending on which library is available ELPA seems to be unstable for small sy...
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
subroutine, public cp_fm_get_diag(matrix, diag)
returns the diagonal elements of a fm
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_to_fm_submat(msource, mtarget, nrow, ncol, s_firstrow, s_firstcol, t_firstrow, t_firstcol)
copy just a part ot the matrix
subroutine, public cp_fm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
gets a submatrix of a full matrix op(target_m)(1:n_rows,1:n_cols) =fm(start_row:start_row+n_rows,...
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
various routines to log and control the output. The idea is that decisions about where to log should ...
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...
Defines the basic variable types.
integer, parameter, public dp
Collection of simple mathematical functions and subroutines.
pure real(kind=dp) function, dimension(min(size(a, 1), size(a, 2))), public get_diag(a)
Return the diagonal elements of matrix a as a vector.
subroutine, public diag(n, a, d, v)
Diagonalize matrix a. The eigenvalues are returned in vector d and the eigenvectors are returned in m...
Interface to the message passing library MPI.
basic linear algebra operations for full matrixes
Definition of physical constants:
real(kind=dp), parameter, public a_fine
subroutine, public init_preconditioner(preconditioner_env, para_env, blacs_env)
...
subroutine, public destroy_preconditioner(preconditioner_env)
...
computes preconditioners, and implements methods to apply them currently used in qs_ot
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.
collects routines that perform operations directly related to MOs
Definition and initialisation of the mo data type.
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
an eigen-space solver for the generalised symmetric eigenvalue problem for sparse matrices,...
subroutine, public ot_eigensolver(matrix_h, matrix_s, matrix_orthogonal_space_fm, matrix_c_fm, preconditioner, eps_gradient, iter_max, size_ortho_space, silent, ot_settings)
...
All the kernel specific subroutines for XAS TDP calculations.
subroutine, public kernel_coulomb_xc(coul_ker, xc_ker, donor_state, xas_tdp_env, xas_tdp_control, qs_env)
Computes, if asked for it, the Coulomb and XC kernel matrices, in the usuall matrix format.
subroutine, public kernel_exchange(ex_ker, donor_state, xas_tdp_env, xas_tdp_control, qs_env)
Computes the exact exchange kernel matrix using RI. Returns an array of 2 matrices,...
Define XAS TDP control type and associated create, release, etc subroutines, as well as XAS TDP envir...
Utilities for X-ray absorption spectroscopy using TDDFPT.
subroutine, public include_rcs_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env)
Includes the SOC effects on the precomputed restricted closed-shell singlet and triplet excitations....
subroutine, public setup_xas_tdp_prob(donor_state, qs_env, xas_tdp_env, xas_tdp_control)
Builds the matrix that defines the XAS TDDFPT generalized eigenvalue problem to be solved for excitat...
subroutine, public solve_xas_tdp_prob(donor_state, xas_tdp_control, xas_tdp_env, qs_env, ex_type)
Solves the XAS TDP generalized eigenvalue problem omega*C = matrix_tdp*C using standard full diagonal...
subroutine, public include_os_soc(donor_state, xas_tdp_env, xas_tdp_control, qs_env)
Includes the SOC effects on the precomputed spin-conserving and spin-flip excitations from an open-sh...
subroutine, public rcs_amew_soc_elements(amew_soc, lr_soc, lr_overlap, domo_soc, pref_trace, pref_overall, pref_diags, symmetric)
Computes the rcs SOC matrix elements between excited states AMEWs based on the LR orbitals.
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Represent a complex full matrix.
keeps the information about the structure of a full matrix
stores all the informations relevant to an mpi environment
Type containing informations about a single donor state.
Type containing control information for TDP XAS calculations.
Type containing informations such as inputs and results for TDP XAS calculations.