subroutine calc_n_quads
! this routines calculates the number of "important" quadrupels
! calculating T2*T2 essentially
! todo: do i double count here? and how do i solve this issue?
! since different excitation generators can lead to the same
! quadruple excitation or?
! yes there are worst case 18 different permutations leading to the
! same quadruple excitation!
! so either divide by this number!
! or, for not too big numbers of double excitations create a
! specific hash table for the quadruple indexing out of the
! 8 indices i,j,k,l and a,b,c,d ..
! which would also allow me to store the estimated quadrupels
! magnitute(when ignoring the influence of the T1 and T3 operators!)
! but when i store the tripels also i could also estimate the
! quadrupels "exactly" .. which would be quite nice actually!
! todo: hash-table or dividing by 18..
integer :: i, j, ij_ab(2, 2), kl_cd(2, 2), ijab_klcd(8), hash_ind
integer(n_int) :: temp_int(0:nifd)
real(dp) :: phase, amp
logical :: t_found
integer :: ijk_abc(2, 3), l_d(2, 1)
print *, "test doubles: "
do i = 1, cc_ops(2)%n_ops
if (.not. cc_ops(2)%set_flag(i) == 1) cycle
ij_ab = cc_ops(2)%get_ex(i)
print *, "i:", i, "|", ij_ab(1, :), "->", ij_ab(2, :)
end do
if (t_store_hash_quadrupels) then
do i = 1, cc_ops(2)%n_ops
if (cc_ops(2)%set_flag(i) == 1) then
ij_ab = cc_ops(2)%get_ex(i)
do j = i + 1, cc_ops(2)%n_ops
if (cc_ops(2)%set_flag(j) == 1) then
kl_cd = cc_ops(2)%get_ex(j)
! can i just: any(a==b)
if (unique_quad_ind_2_2(ij_ab, kl_cd)) then
! i also want to store the amplitudes
! i gues..
! here i have to first order the indices
! so i < j < k < l and a < b < c < d
! and find the phase factor between them
call order_quad_indices_2_2(ij_ab, kl_cd, phase, &
ijab_klcd)
amp = phase * cc_ops(2)%get_amp(i) * cc_ops(2)%get_amp(j)
! and i need a unique quantity associated with
! these 8 orbital -> just set all the
! corresponding orbitals
temp_int = apply_excit_ops(ilutRef(:, 1), &
[ij_ab(1, :), kl_cd(1, :)], [ij_ab(2, :), kl_cd(2, :)])
call cc_hash_look_up(ijab_klcd, temp_int, quad_hash, &
hash_ind, t_found)
! it it is found in the hash-table i want to
! update the amplitude
if (t_found) then
print *, "repeated doubles: "
print *, "i: ", i, "|", ij_ab
print *, "j: ", j, "|", kl_cd
call cc_hash_update(quad_hash, hash_ind, &
temp_int, amp)
else
! otherwise i want to add the entry
print *, "initial doubles: "
print *, "i: ", i, "|", ij_ab
print *, "j: ", j, "|", kl_cd
call cc_hash_add(quad_hash, hash_ind, &
temp_int, amp)
! and only in this case we found a new
! quadruple coefficient
cc_amp_norm(0, 4) = cc_amp_norm(0, 4) + 1
end if
end if
end if
end do
end if
end do
print *, "cc-4 L0 norm after T2^2", cc_amp_norm(0, 4), "on proc: ", &
iProcIndex
! do i also want to do the T1*T3, T1^2*T2 T1^4
do i = 1, cc_ops(3)%n_ops
ijk_abc = cc_ops(3)%get_ex(i)
do j = 1, cc_ops(1)%n_ops
if (cc_ops(1)%set_flag(j) == 1) then
l_d = cc_ops(1)%get_ex(j)
if (unique_quad_ind_3_1(ijk_abc, l_d)) then
call order_quad_indices_3_1(ijk_abc, l_d, phase, ijab_klcd)
amp = phase * cc_ops(3)%get_amp(i) * cc_ops(1)%get_amp(j)
temp_int = apply_excit_ops(ilutRef, &
[ijk_abc(1, :), l_d(1, 1)], [ijk_abc(2, :), l_d(2, 1)])
call cc_hash_look_up(ijab_klcd, temp_int, quad_hash, &
hash_ind, t_found)
! it it is found in the hash-table i want to
! update the amplitude
if (t_found) then
call cc_hash_update(quad_hash, hash_ind, &
temp_int, amp)
else
! otherwise i want to add the entry
call cc_hash_add(quad_hash, hash_ind, &
temp_int, amp)
! and only in this case we found a new
! quadruple coefficient
cc_amp_norm(0, 4) = cc_amp_norm(0, 4) + 1
end if
end if
end if
end do
end do
print *, "cc-4 L0 norm after T3*T1", cc_amp_norm(0, 4), "on proc: ", &
iProcIndex
else
do i = 1, cc_ops(2)%n_ops
if (cc_ops(2)%set_flag(i) == 1) then
ij_ab = cc_ops(2)%get_ex(i)
do j = i + 1, cc_ops(2)%n_ops
if (cc_ops(2)%set_flag(j) == 1) then
kl_cd = cc_ops(2)%get_ex(j)
! can i just: any(a==b)
if (unique_quad_ind_2_2(ij_ab, kl_cd)) then
cc_amp_norm(0, 4) = cc_amp_norm(0, 4) + 1
end if
end if
end do
end if
end do
end if
end subroutine calc_n_quads