Get the index of the UMat entry to which the LMat entry with given indices shall be added if it is frozen. @param[in] indices array of lenght 6 with the orbital indices of the LMat entry @param[ou] t_par flag indicating if the matrix element enters UMat with a -1 @return index index of the UMat entry to add the LMat entry to, 0 if entry is not frozen
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer(kind=int64), | intent(in) | :: | indices(num_inds) | |||
real(kind=dp), | intent(out) | :: | prefactor |
function frozen_double_entry(indices, prefactor) result(idx)
integer(int64), intent(in) :: indices(num_inds)
real(dp), intent(out) :: prefactor
integer(int64) :: idx(num_ex)
integer :: f_one, f_two, ct, counts, i, rs, marks(3)
logical :: unfrozen(num_inds)
integer(int64) :: uf_idx(4)
idx = 0
unfrozen = indices > 0
! Mark where the unfrozen indices are
marks = 0
! Identify the direct unfrozen pair
! Look for the direct pair of unfrozen indices (these shall stay direct)
do ct = 1, step
if(unfrozen(ct) .and. unfrozen(ct + step)) then
uf_idx(1) = indices(ct)
uf_idx(3) = indices(ct + step)
! Mark the extracted indices so they are not taken again
marks(1) = ct
marks(2) = ct + step
exit
end if
end do
! Now, find the other two (direct or exchange) unfrozen indices
rs = 2
do ct = 1, num_inds
if(unfrozen(ct) .and. .not. any(ct == marks)) then
uf_idx(rs) = indices(ct)
marks(3) = ct
rs = rs + 2
endif
end do
! Now, get the required UMat indices, including all transposed index pairs
idx = permute_umat_inds(int(uf_idx(1)), int(uf_idx(2)), int(uf_idx(3)), int(uf_idx(4)))
! Check the permutation and possible factor of two due to spin
! First, get the two frozen orbitals
f_one = custom_findloc(unfrozen, .false., back=.false.)
f_two = custom_findloc(unfrozen, .false., back=.true.)
! There are two spin configurations in a close-shell frozen scenario for terms
! with a direct frozen orbital (i.e. no permutation required)
! All others enter with a prefactor of -1
if(is_direct(f_one, f_two)) then
prefactor = 2.0_dp
else
prefactor = -1.0_dp
! If this is a diagonal term (only three different indices), permutational symmetry
! gives an extra factor of 2 for the exchange term. If only two different
! indices appear, also the direct term gets this prefactor
counts = 1
! Count the number of different indices
do ct = 2, num_inds
if(.not. any(indices(ct) == indices(1:ct - 1))) counts = counts + 1
end do
if(counts == 2) then
prefactor = 2.0_dp * prefactor
elseif(counts == 3) then
! If there are three different indices, only add the extra factor if there is no direct unfrozen pair
do ct = 1, step
if(is_repeated_pair(indices, ct) .and. unfrozen(ct)) return
end do
prefactor = 2.0_dp * prefactor
end if
end if
end function frozen_double_entry