tdhf_sf_lib Module


Uses

  • module~~tdhf_sf_lib~~UsesGraph module~tdhf_sf_lib tdhf_sf_lib module~oqp_linalg oqp_linalg module~tdhf_sf_lib->module~oqp_linalg module~blas_wrap blas_wrap module~oqp_linalg->module~blas_wrap module~lapack_wrap lapack_wrap module~oqp_linalg->module~lapack_wrap module~mathlib_types mathlib_types module~blas_wrap->module~mathlib_types module~messages messages module~blas_wrap->module~messages module~precision precision module~blas_wrap->module~precision module~lapack_wrap->module~mathlib_types module~lapack_wrap->module~messages module~lapack_wrap->module~precision module~messages->module~precision comm_IOFILE comm_IOFILE module~messages->comm_IOFILE comm_PAR comm_PAR module~messages->comm_PAR module~io_constants io_constants module~messages->module~io_constants iso_fortran_env iso_fortran_env module~precision->iso_fortran_env

Used by

  • module~~tdhf_sf_lib~~UsedByGraph module~tdhf_sf_lib tdhf_sf_lib proc~oqp_tdhf_z_vector oqp_tdhf_z_vector proc~oqp_tdhf_z_vector->module~tdhf_sf_lib proc~tdhf_mrsf_energy tdhf_mrsf_energy proc~tdhf_mrsf_energy->module~tdhf_sf_lib proc~tdhf_sf_energy tdhf_sf_energy proc~tdhf_sf_energy->module~tdhf_sf_lib

Functions

public function get_spin_square(dmat_a, dmat_b, ta, tb, abxc, smat, nocb) result(s2)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in), dimension(:) :: dmat_a
real(kind=dp), intent(in), dimension(:) :: dmat_b
real(kind=dp), intent(in), dimension(:) :: ta
real(kind=dp), intent(in), dimension(:) :: tb
real(kind=dp), intent(in), dimension(:,:) :: abxc
real(kind=dp), intent(in), dimension(:) :: smat
integer, intent(in) :: nocb

Return Value real(kind=dp)


Subroutines

public subroutine sfroesum(fazzfb, pmo, noca, nocb, ivec)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in), dimension(:,:) :: fazzfb
real(kind=dp), intent(inout), dimension(:,:) :: pmo
integer, intent(in) :: noca
integer, intent(in) :: nocb
integer, intent(in) :: ivec

public subroutine sfresvec(q, a, b, vec, eigv, nvec, rnorm, ndsr)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:,:) :: q
real(kind=dp), intent(in), dimension(:,:) :: a
real(kind=dp), intent(in), dimension(:,:) :: b
real(kind=dp), intent(inout), dimension(:,:) :: vec
real(kind=dp), intent(in), dimension(:) :: eigv
integer, intent(in) :: nvec
real(kind=dp), intent(out), dimension(:) :: rnorm
integer, intent(in) :: ndsr

public subroutine sfqvec(q, xm, eigv, ndsr)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout), dimension(:,:) :: q
real(kind=dp), intent(in), dimension(:) :: xm
real(kind=dp), intent(in), dimension(:) :: eigv
integer, intent(in) :: ndsr

public subroutine sfesum(eiga, eigb, pmo, z, noca, nocb, ivec)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in) :: eiga(:)
real(kind=dp), intent(in) :: eigb(:)
real(kind=dp), intent(inout) :: pmo(:,:)
real(kind=dp), intent(in) :: z(:,:)
integer, intent(in) :: noca
integer, intent(in) :: nocb
integer, intent(in) :: ivec

public subroutine trfrmb(bvec, vec, nvec, ndsr)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout), dimension(:,:) :: bvec
real(kind=dp), intent(in), dimension(:,:) :: vec
integer, intent(in) :: nvec
integer, intent(in) :: ndsr

public subroutine sfdmat(bvec, abxc, mo_a, ta, tb, noca, nocb)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in), dimension(:) :: bvec
real(kind=dp), intent(inout), dimension(:,:) :: abxc
real(kind=dp), intent(in), dimension(:,:) :: mo_a
real(kind=dp), intent(out), dimension(:) :: ta
real(kind=dp), intent(out), dimension(:) :: tb
integer, intent(in) :: noca
integer, intent(in) :: nocb

public subroutine get_transitions(trans, noca, nocb, nbf)

Arguments

Type IntentOptional Attributes Name
integer, intent(out), dimension(:,:) :: trans
integer, intent(in) :: noca
integer, intent(in) :: nocb
integer, intent(in) :: nbf

public subroutine print_results(infos, bvec_mo, excitation_energy, trans, dip, spin_square, nstates)

Arguments

Type IntentOptional Attributes Name
type(information), intent(in), target :: infos
real(kind=dp), intent(in), dimension(:,:) :: bvec_mo
real(kind=dp), intent(in), dimension(:) :: excitation_energy
integer, intent(in), dimension(:,:) :: trans
real(kind=dp), intent(in), dimension(:,:,:) :: dip
real(kind=dp), intent(in), dimension(:) :: spin_square
integer, intent(in) :: nstates

public subroutine sfrorhs(rhs, xhxa, xhxb, hpta, hptb, tij, tab, fa, fb, noca, nocb)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:) :: rhs
real(kind=dp), intent(inout), dimension(:,:) :: xhxa
real(kind=dp), intent(inout), dimension(:,:) :: xhxb
real(kind=dp), intent(in), dimension(:,:) :: hpta
real(kind=dp), intent(in), dimension(:,:) :: hptb
real(kind=dp), intent(in), dimension(:,:) :: tij
real(kind=dp), intent(in), dimension(:,:) :: tab
real(kind=dp), intent(in), dimension(:,:) :: fa
real(kind=dp), intent(in), dimension(:,:) :: fb
integer, intent(in) :: noca
integer, intent(in) :: nocb

public subroutine sfromcal(xm, xminv, energy, fa, fb, noca, nocb)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:) :: xm
real(kind=dp), intent(out), dimension(:) :: xminv
real(kind=dp), intent(in), dimension(:) :: energy
real(kind=dp), intent(in), dimension(:,:) :: fa
real(kind=dp), intent(in), dimension(:,:) :: fb
integer, intent(in) :: noca
integer, intent(in) :: nocb

public subroutine sfrogen(ava, avb, pv, noca, nocb)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:,:) :: ava
real(kind=dp), intent(out), dimension(:,:) :: avb
real(kind=dp), intent(in), dimension(:) :: pv
integer, intent(in) :: noca
integer, intent(in) :: nocb

public subroutine sfrolhs(pmo, z, e, fa, fb, hpza, hpzb, noca, nocb)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:) :: pmo
real(kind=dp), intent(in), dimension(:) :: z
real(kind=dp), intent(in), dimension(:) :: e
real(kind=dp), intent(in), dimension(:,:) :: fa
real(kind=dp), intent(in), dimension(:,:) :: fb
real(kind=dp), intent(in), dimension(:,:) :: hpza
real(kind=dp), intent(in), dimension(:,:) :: hpzb
integer, intent(in) :: noca
integer, intent(in) :: nocb

public subroutine pcgrbpini(r, pk, error, d, xm_in, a_pk)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:) :: r
real(kind=dp), intent(out), dimension(:) :: pk
real(kind=dp), intent(out) :: error
real(kind=dp), intent(in), dimension(:) :: d
real(kind=dp), intent(in), dimension(:) :: xm_in
real(kind=dp), intent(in), dimension(:) :: a_pk

public subroutine pcgb(pk, r, xm_in)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out) :: pk(:)
real(kind=dp), intent(in) :: r(:)
real(kind=dp), intent(in) :: xm_in(:)

public subroutine sfropcal(pa, pb, ta, tb, z, noca, nocb)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:,:) :: pa
real(kind=dp), intent(out), dimension(:,:) :: pb
real(kind=dp), intent(in), dimension(:,:) :: ta
real(kind=dp), intent(in), dimension(:,:) :: tb
real(kind=dp), intent(in), dimension(:) :: z
integer, intent(in) :: noca
integer, intent(in) :: nocb

public subroutine sfrowcal(wmo, target_energy, mo_energy_a, fa, fb, bvec, xk, xhxa, xhxb, hppija, hppijb, noca, nocb)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:,:) :: wmo
real(kind=dp), intent(in) :: target_energy
real(kind=dp), intent(in), dimension(:) :: mo_energy_a
real(kind=dp), intent(in), dimension(:,:) :: fa
real(kind=dp), intent(in), dimension(:,:) :: fb
real(kind=dp), intent(in), dimension(:) :: bvec
real(kind=dp), intent(in), dimension(:) :: xk
real(kind=dp), intent(in), dimension(:,:) :: xhxa
real(kind=dp), intent(in), dimension(:,:) :: xhxb
real(kind=dp), intent(in), dimension(:,:) :: hppija
real(kind=dp), intent(in), dimension(:,:) :: hppijb
integer, intent(in) :: noca
integer, intent(in) :: nocb

public subroutine get_transition_density(trden, bvec_mo, nbf, nocca, noccb, nstates)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(out), dimension(:,:,:,:) :: trden
real(kind=dp), intent(in), dimension(:,:) :: bvec_mo
integer, intent(in) :: nbf
integer, intent(in) :: nocca
integer, intent(in) :: noccb
integer, intent(in) :: nstates

public subroutine get_transition_dipole(basis, dip, mo_a, trden, nstates)

Arguments

Type IntentOptional Attributes Name
type(basis_set), intent(in) :: basis
real(kind=dp), intent(out) :: dip(:,:,:)
real(kind=dp), intent(in) :: mo_a(:,:)
real(kind=dp), intent(in) :: trden(:,:,:,:)
integer, intent(in) :: nstates