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

it works with new routines for pt2 tc

Browse Source
This commit is contained in:
eginer 2024-05-07 20:52:10 +02:00
parent 687259c25f
commit 42fdb3c435
4 changed files with 25 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
plugins/local/cipsi_tc_bi_ortho/get_d0_transp.irp.f
View File

@ -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 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(gen, det, N_int, hij) ! need to take conjugate of this
! call i_h_j_complex(det, gen, N_int, hij) ! 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 else
phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int) phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2, N_int)
hij = hij_cache1(p2) * phase hij = hij_cache1(p2) * phase
hji = hji_cache1(p2) * phase
end if end if
if (hij == (0.d0,0.d0)) cycle if (hij == 0.d0.or.hji == 0.d0) cycle
!DIR$ LOOP COUNT AVG(4) !DIR$ LOOP COUNT AVG(4)
do k=1,N_states do k=1,N_states
mat_r(k, p1, p2) = mat_r(k, p1, p2) + coefs(k,2) * hij ! HOTSPOT 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 mat_l(k, p1, p2) = mat_l(k, p1, p2) + coefs(k,1) * hji ! HOTSPOT
enddo enddo
end do 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 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(gen, det, N_int, hij) ! need to take conjugate of this
! call i_h_j_complex(det, gen, N_int, hij) ! 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)
if (hij == 0.d0) cycle if (hij == 0.d0.or.hji == 0.d0) cycle
else else
! hij = (mo_two_e_integral_complex(p1, p2, puti, putj) - mo_two_e_integral_complex(p2, p1, puti, putj)) ! 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(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)) 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 hji = (mo_bi_ortho_tc_two_e_transp(puti, putj, p1, p2) - mo_bi_ortho_tc_two_e_transp(puti, putj, p2, p1))
hij = (hij) * get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2, N_int) 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 end if
!DIR$ LOOP COUNT AVG(4) !DIR$ LOOP COUNT AVG(4)
do k=1,N_states do k=1,N_states
mat_r(k, puti, putj) = mat_r(k, puti, putj) + coefs(k,2) * hij 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 mat_l(k, puti, putj) = mat_l(k, puti, putj) + coefs(k,1) * hji
enddo enddo
end do end do
end do end do
end if end if

4
plugins/local/cipsi_tc_bi_ortho/get_d1_transp.irp.f
View File

@ -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 ! gen is a selector; mask is ionized generator; det is alpha
! hij is contribution to <psi|H|alpha> ! hij is contribution to <psi|H|alpha>
! call i_h_j_complex(gen, det, N_int, hij) ! 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_both(det, gen, N_int, hij,hji)
call htilde_mu_mat_opt_bi_ortho_no_3e(gen, det, N_int, hji) ! call htilde_mu_mat_opt_bi_ortho_no_3e(gen, det, N_int, hji)
!DIR$ LOOP COUNT AVG(4) !DIR$ LOOP COUNT AVG(4)
do k=1,N_states do k=1,N_states
! take conjugate to get contribution to <alpha|H|psi> instead of <psi|H|alpha> ! take conjugate to get contribution to <alpha|H|psi> instead of <psi|H|alpha>

17
plugins/local/slater_tc/slater_tc_opt.irp.f
View File

@ -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 BEGIN_DOC
! !
@ -199,24 +199,27 @@ subroutine htilde_mu_mat_opt_bi_ortho_no_3e_both(key_j, key_i, Nint, htot)
implicit none implicit none
integer, intent(in) :: Nint integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) 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 integer :: degree
htot = 0.d0 hji = 0.d0
hij = 0.d0
call get_excitation_degree(key_i, key_j, degree, Nint) call get_excitation_degree(key_i, key_j, degree, Nint)
if(degree.gt.2) return if(degree.gt.2) return
if(degree == 0) then 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 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 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 endif
if(degree==0) then if(degree==0) then
htot += nuclear_repulsion hji += nuclear_repulsion
hij += nuclear_repulsion
endif endif
end end

4
plugins/local/slater_tc/slater_tc_opt_single.irp.f
View File

@ -652,7 +652,7 @@ subroutine single_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, hj
hmono = 0.d0 hmono = 0.d0
htwoe = 0.d0 htwoe = 0.d0
hji = 0.d0 hji = 0.d0
hji = 0.d0 hij = 0.d0
call get_excitation_degree(key_i, key_j, degree, Nint) call get_excitation_degree(key_i, key_j, degree, Nint)
if(degree.ne.1)then if(degree.ne.1)then
return 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 get_single_excitation(key_i, key_j, exc, phase, Nint)
call decode_exc(exc,1,h1,p1,h2,p2,s1,s2) 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 end