LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

added full three body
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
eginer 2023-09-13 18:42:50 +02:00
parent 6ba3f48acb
commit 14edfa839b
2 changed files with 39 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
src/tc_bi_ortho/h_mat_triple.irp.f
View File

@ -267,64 +267,57 @@ subroutine triple_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe,
integer(bit_kind), intent(in) :: key_j(N_int,2),key_i(N_int,2) integer(bit_kind), intent(in) :: key_j(N_int,2),key_i(N_int,2)
integer, intent(in) :: Nint integer, intent(in) :: Nint
double precision, intent(out) :: hmono, htwoe, hthree, htot double precision, intent(out) :: hmono, htwoe, hthree, htot
integer :: occ(N_int*bit_kind_size,2) integer :: degree
integer :: Ne(2),i,j,ii,jj,ispin,jspin,k,kk integer :: h1, p1, h2, p2, s1, s2, h3, p3, s3
integer :: degree,exc_double(0:2,2,2),exc_single(0:2,2,2) integer :: holes_array(100,2),particles_array(100,2),degree_array(2)
integer :: degree_alpha,degree_beta double precision :: phase,sym_3_e_int_from_6_idx_tensor
integer :: h1, p1, h2, p2, s1, s2, h3, p3, s3, h4, p4, s4
double precision :: phase_double, phase_single
integer(bit_kind) :: key_j_alpha(N_int,2),key_i_alpha(N_int,2)
integer(bit_kind) :: key_j_beta(N_int,2),key_i_beta(N_int,2)
integer :: other_spin(2)
hmono = 0.d0 hmono = 0.d0
htwoe = 0.d0 htwoe = 0.d0
hthree = 0.d0 hthree = 0.d0
htot = 0.d0 htot = 0.d0
call bitstring_to_list_ab(key_i,occ,Ne,N_int) call get_excitation_general(key_j, key_i, Nint,degree_array,holes_array, particles_array,phase)
call get_excitation_degree(key_i,key_j,degree,N_int) degree = degree_array(1) + degree_array(2)
if(degree.ne.3)then if(degree .ne. 3)return
return if(degree_array(1)==3.or.degree_array(2)==3)then
endif if(degree_array(1) == 3)then
other_spin(1) = 2 h1 = holes_array(1,1)
other_spin(2) = 1 h2 = holes_array(2,1)
do i = 1, N_int h3 = holes_array(1,1)
key_j_alpha(i,1) = key_j(i,1) p1 = particles_array(1,1)
key_j_alpha(i,2) = 0_bit_kind p2 = particles_array(2,1)
key_i_alpha(i,1) = key_i(i,1) p3 = particles_array(1,1)
key_i_alpha(i,2) = 0_bit_kind else
h1 = holes_array(1,2)
key_j_beta(i,2) = key_j(i,2) h2 = holes_array(2,2)
key_j_beta(i,1) = 0_bit_kind h3 = holes_array(1,2)
key_i_beta(i,2) = key_i(i,2) p1 = particles_array(1,2)
key_i_beta(i,1) = 0_bit_kind p2 = particles_array(2,2)
enddo p3 = particles_array(1,2)
! check whether it is a triple excitation of the same spin endif
hthree = sym_3_e_int_from_6_idx_tensor(p3, p2, p1, h3, h2, h1)
call get_excitation_degree(key_i_alpha,key_j_alpha,degree_alpha,N_int)
call get_excitation_degree(key_i_beta,key_j_beta,degree_beta,N_int)
if(degree_alpha==3.or.degree_beta==3)then
return
else else
if(degree_alpha == 2.and.degree_beta == 1)then ! double alpha + single beta if(degree_array(1) == 2.and.degree_array(2) == 1)then ! double alpha + single beta
call get_double_excitation(key_i_alpha,key_j_alpha,exc_double,phase_double,N_int) h1 = holes_array(1,1)
call decode_exc(exc_double,2,h1,p1,h2,p2,s1,s2) h2 = holes_array(2,1)
call get_single_excitation(key_i_beta,key_j_beta,exc_single,phase_single,N_int) h3 = holes_array(1,2)
call decode_exc(exc_single,1,h3,p3,h4,p4,s3,s4) p1 = particles_array(1,1)
else if(degree_beta == 2 .and. degree_alpha == 1)then ! double beta + single alpha p2 = particles_array(2,1)
call get_double_excitation(key_i_beta,key_j_beta,exc_double,phase_double,N_int) p3 = particles_array(1,2)
call decode_exc(exc_double,2,h1,p1,h2,p2,s1,s2) else if(degree_array(2) == 2 .and. degree_array(1) == 1)then ! double beta + single alpha
call get_single_excitation(key_i_alpha,key_j_alpha,exc_single,phase_single,N_int) h1 = holes_array(1,2)
call decode_exc(exc_single,1,h3,p3,h4,p4,s3,s4) h2 = holes_array(2,2)
h3 = holes_array(1,1)
p1 = particles_array(1,2)
p2 = particles_array(2,2)
p3 = particles_array(1,1)
else else
print*,'PB !!' print*,'PB !!'
print*,'degree_beta, degree_alpha',degree_beta, degree_alpha
print*,'degree',degree
stop stop
endif endif
hthree = three_body_ints_bi_ort(p3,p2,p1,h3,h2,h1) - three_body_ints_bi_ort(p3,p2,p1,h3,h1,h2) hthree = three_body_ints_bi_ort(p3,p2,p1,h3,h2,h1) - three_body_ints_bi_ort(p3,p2,p1,h3,h1,h2)
hthree *= phase_single * phase_double
endif endif
hthree *= phase
htot = hthree htot = hthree
end end

3
src/tc_bi_ortho/slater_tc_opt.irp.f
View File

@ -95,9 +95,6 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree,
call double_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot) call double_htilde_mu_mat_fock_bi_ortho(Nint, key_j, key_i, hmono, htwoe, hthree, htot)
endif endif
else else
if(degree==3)then
print*,'degree == 3'
endif
if(degree.gt.3) return if(degree.gt.3) return
if(degree == 0) then if(degree == 0) then
call diag_htilde_mu_mat_fock_bi_ortho (Nint, key_i, hmono, htwoe, hthree, htot) call diag_htilde_mu_mat_fock_bi_ortho (Nint, key_i, hmono, htwoe, hthree, htot)