mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 20:23:40 +02:00
it works with new routines for pt2 tc
This commit is contained in:
parent
687259c25f
commit
42fdb3c435
@ -45,33 +45,16 @@ subroutine get_d0_transp(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask,
|
||||
call apply_particles(mask, 1,p1,2,p2, det, ok, N_int)
|
||||
! call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this
|
||||
! call i_h_j_complex(det, gen, N_int, hij)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e(det,gen,N_int, hij)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e_both(det,gen,N_int, hij,hji)
|
||||
else
|
||||
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
|
||||
hij = hij_cache1(p2) * phase
|
||||
hji = hji_cache1(p2) * phase
|
||||
end if
|
||||
if (hij == (0.d0,0.d0)) cycle
|
||||
if (hij == 0.d0.or.hji == 0.d0) cycle
|
||||
!DIR$ LOOP COUNT AVG(4)
|
||||
do k=1,N_states
|
||||
mat_r(k, p1, p2) = mat_r(k, p1, p2) + coefs(k,2) * hij ! HOTSPOT
|
||||
enddo
|
||||
end do
|
||||
!!!!!!!!!! <phi|H|alpha>
|
||||
do p2=1, mo_num
|
||||
if(bannedOrb(p2,2)) cycle
|
||||
if(banned(p1, p2, bant)) cycle ! rentable?
|
||||
if(p1 == h1 .or. p2 == h2) then
|
||||
call apply_particles(mask, 1,p1,2,p2, det, ok, N_int)
|
||||
! call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this
|
||||
! call i_h_j_complex(det, gen, N_int, hij)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e(gen,det,N_int, hji)
|
||||
else
|
||||
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
|
||||
hji = hji_cache1(p2) * phase
|
||||
end if
|
||||
if (hji == (0.d0,0.d0)) cycle
|
||||
!DIR$ LOOP COUNT AVG(4)
|
||||
do k=1,N_states
|
||||
mat_l(k, p1, p2) = mat_l(k, p1, p2) + coefs(k,1) * hji ! HOTSPOT
|
||||
enddo
|
||||
end do
|
||||
@ -98,40 +81,25 @@ subroutine get_d0_transp(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask,
|
||||
call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int)
|
||||
!call i_h_j_complex(gen, det, N_int, hij) ! need to take conjugate of this
|
||||
! call i_h_j_complex(det, gen, N_int, hij)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e(det,gen,N_int, hij)
|
||||
if (hij == 0.d0) cycle
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e_both(det,gen,N_int, hij,hji)
|
||||
if (hij == 0.d0.or.hji == 0.d0) cycle
|
||||
else
|
||||
! hij = (mo_two_e_integral_complex(p1, p2, puti, putj) - mo_two_e_integral_complex(p2, p1, puti, putj))
|
||||
! hij = (mo_bi_ortho_tc_two_e(p1, p2, puti, putj) - mo_bi_ortho_tc_two_e(p2, p1, puti, putj))
|
||||
hij = (mo_bi_ortho_tc_two_e(puti, putj, p1, p2) - mo_bi_ortho_tc_two_e(puti, putj, p2, p1))
|
||||
if (hij == 0.d0) cycle
|
||||
hij = (hij) * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
|
||||
hji = (mo_bi_ortho_tc_two_e_transp(puti, putj, p1, p2) - mo_bi_ortho_tc_two_e_transp(puti, putj, p2, p1))
|
||||
if (hij == 0.d0.or.hji == 0.d0) cycle
|
||||
phase = get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
|
||||
hij = (hij) * phase
|
||||
hji = (hji) * phase
|
||||
end if
|
||||
!DIR$ LOOP COUNT AVG(4)
|
||||
do k=1,N_states
|
||||
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,2) * hij
|
||||
enddo
|
||||
end do
|
||||
|
||||
!!!!!!!!!! <phi|H|alpha>
|
||||
do putj=puti+1, mo_num
|
||||
if(bannedOrb(putj, sp)) cycle
|
||||
if(banned(puti, putj, bant)) cycle ! rentable?
|
||||
if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then
|
||||
call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e(gen,det,N_int, hji)
|
||||
if (hji == 0.d0) cycle
|
||||
else
|
||||
! hji = (mo_bi_ortho_tc_two_e( p1, p2, puti, putj) - mo_bi_ortho_tc_two_e( p2, p1, puti, putj))
|
||||
hji = (mo_bi_ortho_tc_two_e_transp(puti, putj, p1, p2 ) - mo_bi_ortho_tc_two_e_transp( puti, putj, p2, p1))
|
||||
if (hji == 0.d0) cycle
|
||||
hji = (hji) * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int)
|
||||
end if
|
||||
!DIR$ LOOP COUNT AVG(4)
|
||||
do k=1,N_states
|
||||
mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,1) * hji
|
||||
enddo
|
||||
end do
|
||||
|
||||
end do
|
||||
end if
|
||||
|
||||
|
@ -335,8 +335,8 @@ subroutine get_d1_transp(gen, phasemask, bannedOrb, banned, mat_l, mat_r, mask,
|
||||
! gen is a selector; mask is ionized generator; det is alpha
|
||||
! hij is contribution to <psi|H|alpha>
|
||||
! call i_h_j_complex(gen, det, N_int, hij)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e(det, gen, N_int, hij)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e(gen, det, N_int, hji)
|
||||
call htilde_mu_mat_opt_bi_ortho_no_3e_both(det, gen, N_int, hij,hji)
|
||||
! call htilde_mu_mat_opt_bi_ortho_no_3e(gen, det, N_int, hji)
|
||||
!DIR$ LOOP COUNT AVG(4)
|
||||
do k=1,N_states
|
||||
! take conjugate to get contribution to <alpha|H|psi> instead of <psi|H|alpha>
|
||||
|
@ -181,7 +181,7 @@ end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine htilde_mu_mat_opt_bi_ortho_no_3e_both(key_j, key_i, Nint, htot)
|
||||
subroutine htilde_mu_mat_opt_bi_ortho_no_3e_both(key_j, key_i, Nint, hji,hij)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
@ -199,24 +199,27 @@ subroutine htilde_mu_mat_opt_bi_ortho_no_3e_both(key_j, key_i, Nint, htot)
|
||||
implicit none
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||
double precision, intent(out) :: htot
|
||||
double precision, intent(out) :: hji,hij
|
||||
integer :: degree
|
||||
|
||||
htot = 0.d0
|
||||
hji = 0.d0
|
||||
hij = 0.d0
|
||||
|
||||
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||
if(degree.gt.2) return
|
||||
|
||||
if(degree == 0) then
|
||||
call diag_htilde_mu_mat_fock_bi_ortho_no_3e(Nint, key_i,htot)
|
||||
call diag_htilde_mu_mat_fock_bi_ortho_no_3e(Nint, key_i,hji)
|
||||
hij = hji
|
||||
else if (degree == 1) then
|
||||
call single_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint,key_j, key_i , htot)
|
||||
call single_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint,key_j, key_i , hji,hij)
|
||||
else if(degree == 2) then
|
||||
call double_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, htot)
|
||||
call double_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, hji,hij)
|
||||
endif
|
||||
|
||||
if(degree==0) then
|
||||
htot += nuclear_repulsion
|
||||
hji += nuclear_repulsion
|
||||
hij += nuclear_repulsion
|
||||
endif
|
||||
|
||||
end
|
||||
|
@ -652,7 +652,7 @@ subroutine single_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, hj
|
||||
hmono = 0.d0
|
||||
htwoe = 0.d0
|
||||
hji = 0.d0
|
||||
hji = 0.d0
|
||||
hij = 0.d0
|
||||
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||
if(degree.ne.1)then
|
||||
return
|
||||
@ -661,7 +661,7 @@ subroutine single_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, hj
|
||||
|
||||
call get_single_excitation(key_i, key_j, exc, phase, Nint)
|
||||
call decode_exc(exc,1,h1,p1,h2,p2,s1,s2)
|
||||
call get_single_excitation_from_fock_tc_no_3e_both(Nint, key_i, key_j, h1, p1, s1, phase, hmono, htwoe, hji,hij)
|
||||
call get_single_excitation_from_fock_tc_no_3e_both(Nint, key_i, key_j, h1, p1, s1, phase, hji,hij)
|
||||
|
||||
end
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user