Skip to content
Permalink
Browse files

XAS_TDP| Added electronic quadrupole oscillator strengths

  • Loading branch information...
abussy authored and pseewald committed Jun 17, 2019
1 parent d37ed58 commit e2f7194ae7e83cbb822ecab5f9a0ed13e11701f1
Showing with 999 additions and 464 deletions.
  1. +7 −3 src/hfx_libint_wrapper.F
  2. +3 −1 src/input_constants.F
  3. +69 −41 src/input_cp2k_dft.F
  4. +16 −16 src/qs_operators_ao.F
  5. +285 −191 src/xas_tdp_atom.F
  6. +2 −0 src/xas_tdp_kernel.F
  7. +314 −73 src/xas_tdp_methods.F
  8. +49 −18 src/xas_tdp_types.F
  9. +254 −121 src/xas_tdp_utils.F
@@ -22,14 +22,15 @@ MODULE hfx_libint_wrapper

USE ISO_C_BINDING, ONLY: C_F_POINTER,&
C_F_PROCPOINTER,&
C_NULL_PTR
C_NULL_PTR,&
C_FUNPTR
USE kinds, ONLY: dp
#if(__LIBINT)
USE libint_f, ONLY: &
libint2_build, libint2_build_eri, libint2_build_eri1, libint2_cleanup_eri, &
libint2_cleanup_eri1, libint2_init_eri, libint2_init_eri1, libint2_static_cleanup, &
libint2_static_init, libint_t, libint2_max_am_eri, libint2_init_3eri, libint2_cleanup_3eri,&
libint2_build_3eri
libint2_static_init, libint_t, libint2_max_am_eri, libint2_init_3eri, libint2_cleanup_3eri!,&
!libint2_build_3eri
#endif
USE orbital_pointers, ONLY: nco
#include "./base/base_uses.f90"
@@ -68,6 +69,9 @@ MODULE hfx_libint_wrapper
#endif
END TYPE

!This is a hack because 3-center ERIs are bugged on libint 2.5
TYPE(C_FUNPTR), DIMENSION(0:5,0:5,0:7), BIND(C) :: libint2_build_3eri

CONTAINS


@@ -633,7 +633,9 @@ MODULE input_constants
INTEGER, PARAMETER, PUBLIC :: xas_tdp_by_index = 1, &
xas_tdp_by_kind = 2, &
xas_tdp_roks = 1, &
xas_tdp_uks = 2
xas_tdp_uks = 2, &
xas_tdp_para_atom = 1, &
xas_tdp_para_grid = 2

! Form of dipole operator for TDDFPT oscillator strength calculation
INTEGER, PARAMETER, PUBLIC :: tddfpt_dipole_berry = 1, &

Large diffs are not rendered by default.

@@ -1054,11 +1054,12 @@ END SUBROUTINE p_xyz_ao
!> calculated in terms of the contracted basis functions
!> \param qs_env environment for the lists and the basis sets
!> \param rc reference vector position
!> \param order maximum order of the momentum, for the dipole order = 1
!> \param order maximum order of the momentum, for the dipole order = 1, order = -2 for quad only
!> \param minimum_image take into account only the first neighbors in the lists
!> \param soft ...
!> \par History
!> 03.2006 created [MI]
!> 06.2019 added quarupole only option (A.Bussy)
!> \author MI
! **************************************************************************************************

@@ -1072,9 +1073,9 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)

CHARACTER(len=*), PARAMETER :: routineN = 'rRc_xyz_ao', routineP = moduleN//':'//routineN

INTEGER :: handle, i, iatom, icol, ikind, imom, inode, irow, iset, jatom, jkind, jset, &
last_jatom, ldab, ldsa, ldsb, ldwork, M_dim, maxl, ncoa, ncob, nkind, nrow, nseta, nsetb, &
sgfa, sgfb
INTEGER :: handle, iatom, icol, ikind, imom, inode, irow, iset, jatom, jkind, jset, &
last_jatom, ldab, ldsa, ldsb, ldwork, M_dim, maxl, ncoa, ncob, nkind, nseta, nsetb, &
sgfa, sgfb, smom
INTEGER, DIMENSION(:), POINTER :: la_max, la_min, lb_max, npgfa, npgfb, &
nsgfa, nsgfb
INTEGER, DIMENSION(:, :), POINTER :: first_sgfa, first_sgfb
@@ -1129,16 +1130,18 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)

ldab = ldwork

M_dim = ncoset(order)-1
smom = 1
IF (order == -2) smom = 4
M_dim = ncoset(ABS(order))-1
CPASSERT(M_dim <= SIZE(op, 1))

ALLOCATE (mab(ldab, ldab, M_dim))
ALLOCATE (mab(ldab, ldab, 1:M_dim))
mab(1:ldab, 1:ldab, 1:M_dim) = 0.0_dp
ALLOCATE (work(ldwork, ldwork))
work(1:ldwork, 1:ldwork) = 0.0_dp
ALLOCATE (op_dip(M_dim))
ALLOCATE (op_dip(smom:M_dim))

DO imom = 1, M_dim
DO imom = smom, M_dim
NULLIFY (op_dip(imom)%block)
END DO

@@ -1209,7 +1212,7 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)
icol = iatom
END IF

DO imom = 1, M_dim
DO imom = smom, M_dim
NULLIFY (op_dip(imom)%block)
CALL dbcsr_get_block_p(matrix=op(imom)%matrix, &
row=irow, col=icol, block=op_dip(imom)%block, found=found)
@@ -1220,7 +1223,6 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)
rab2 = rab(1)*rab(1)+rab(2)*rab(2)+rab(3)*rab(3)
dab = SQRT(rab2)

nrow = 0
DO iset = 1, nseta

ncoa = npgfa(iset)*ncoset(la_max(iset))
@@ -1240,9 +1242,9 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)
CALL moment(la_max(iset), npgfa(iset), zeta(:, iset), &
rpgfa(:, iset), la_min(iset), &
lb_max(jset), npgfb(jset), zetb(:, jset), rpgfb(:, jset), &
order, rac, rbc, mab)
ABS(order), rac, rbc, mab)

DO imom = 1, M_dim
DO imom = smom, M_dim
! *** Contraction ***
CALL dgemm("N", "N", ncoa, nsgfb(jset), ncob, &
1.0_dp, mab(1, 1, imom), ldab, sphi_b(1, sgfb), ldsb, &
@@ -1266,15 +1268,13 @@ SUBROUTINE rRc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)

END DO ! jset

nrow = nrow+ncoa

END DO ! iset

END DO
CALL neighbor_list_iterator_release(nl_iterator)

DO i = 1, 3
NULLIFY (op_dip(i)%block)
DO imom = smom, M_dim
NULLIFY (op_dip(imom)%block)
END DO
DEALLOCATE (op_dip)

0 comments on commit e2f7194

Please sign in to comment.
You can’t perform that action at this time.