mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-08 08:57:19 +02:00
renaming the routines in tc slater rules in _slow when they are naively built
This commit is contained in:
parent
1d5ff0df66
commit
daf8b1c3dc
@ -27,7 +27,7 @@ subroutine get_delta_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||||
|
||||
i = 1
|
||||
j = 1
|
||||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
call hmat_bi_ortho (psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
|
||||
|
||||
delta = 0.d0
|
||||
@ -39,7 +39,7 @@ subroutine get_delta_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||||
do j = 1, ndet
|
||||
|
||||
! < I | Htilde | J >
|
||||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
! < I | H | J >
|
||||
call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
|
||||
|
||||
@ -78,7 +78,7 @@ subroutine get_htc_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||||
|
||||
i = 1
|
||||
j = 1
|
||||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
|
||||
delta = 0.d0
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) SCHEDULE(dynamic,8) &
|
||||
@ -88,7 +88,7 @@ subroutine get_htc_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||||
do j = 1, ndet
|
||||
|
||||
! < I | Htilde | J >
|
||||
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||
|
||||
delta(i) = delta(i) + psicoef(j) * htc_tot
|
||||
enddo
|
||||
|
@ -2,7 +2,7 @@
|
||||
BEGIN_PROVIDER [ double precision, e_tilde_00]
|
||||
implicit none
|
||||
double precision :: hmono,htwoe,hthree,htot
|
||||
call htilde_mu_mat_bi_ortho(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,htot)
|
||||
e_tilde_00 = htot
|
||||
END_PROVIDER
|
||||
|
||||
@ -18,11 +18,11 @@
|
||||
do i = 1, N_det
|
||||
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
|
||||
if(degree == 1 .or. degree == 2)then
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i),HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i),HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
|
||||
delta_e = e_tilde_00 - e_i0
|
||||
coef_pt1 = htilde_ij / delta_e
|
||||
call htilde_mu_mat_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
e_pt2_tc_bi_orth += coef_pt1 * htilde_ij
|
||||
if(degree == 1)then
|
||||
e_pt2_tc_bi_orth_single += coef_pt1 * htilde_ij
|
||||
@ -37,7 +37,7 @@
|
||||
BEGIN_PROVIDER [ double precision, e_tilde_bi_orth_00]
|
||||
implicit none
|
||||
double precision :: hmono,htwoe,hthree,htilde_ij
|
||||
call htilde_mu_mat_bi_ortho(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,e_tilde_bi_orth_00)
|
||||
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,e_tilde_bi_orth_00)
|
||||
e_tilde_bi_orth_00 += nuclear_repulsion
|
||||
END_PROVIDER
|
||||
|
||||
@ -57,7 +57,7 @@
|
||||
e_corr_double_bi_orth = 0.d0
|
||||
do i = 1, N_det
|
||||
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
|
||||
call htilde_mu_mat_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
if(degree == 1)then
|
||||
e_corr_single_bi_orth += reigvec_tc_bi_orth(i,1) * htilde_ij/reigvec_tc_bi_orth(1,1)
|
||||
e_corr_single_bi_orth_abs += dabs(reigvec_tc_bi_orth(i,1) * htilde_ij/reigvec_tc_bi_orth(1,1))
|
||||
@ -80,7 +80,7 @@
|
||||
do i = 1, N_det
|
||||
accu += reigvec_tc_bi_orth(i,1) * leigvec_tc_bi_orth(i,1)
|
||||
do j = 1, N_det
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,j),psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j),psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
e_tc_left_right += htilde_ij * reigvec_tc_bi_orth(i,1) * leigvec_tc_bi_orth(j,1)
|
||||
enddo
|
||||
enddo
|
||||
@ -99,8 +99,8 @@ BEGIN_PROVIDER [ double precision, coef_pt1_bi_ortho, (N_det)]
|
||||
if(degree==0)then
|
||||
coef_pt1_bi_ortho(i) = 1.d0
|
||||
else
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i),HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i),HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
|
||||
delta_e = e_tilde_00 - e_i0
|
||||
coef_pt1 = htilde_ij / delta_e
|
||||
coef_pt1_bi_ortho(i)= coef_pt1
|
||||
|
@ -1,4 +1,4 @@
|
||||
subroutine htc_bi_ortho_calc_tdav(v, u, N_st, sze)
|
||||
subroutine htc_bi_ortho_calc_tdav_slow(v, u, N_st, sze)
|
||||
|
||||
use bitmasks
|
||||
|
||||
@ -27,7 +27,7 @@ subroutine htc_bi_ortho_calc_tdav(v, u, N_st, sze)
|
||||
|
||||
i = 1
|
||||
j = 1
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,j), N_int, htot)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,j), N_int, htot)
|
||||
|
||||
v = 0.d0
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) SCHEDULE(dynamic,8) &
|
||||
@ -36,7 +36,7 @@ subroutine htc_bi_ortho_calc_tdav(v, u, N_st, sze)
|
||||
do istate = 1, N_st
|
||||
do i = 1, sze
|
||||
do j = 1, sze
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,j), N_int, htot)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,j), N_int, htot)
|
||||
v(i,istate) = v(i,istate) + htot * u(j,istate)
|
||||
enddo
|
||||
enddo
|
||||
@ -45,7 +45,7 @@ subroutine htc_bi_ortho_calc_tdav(v, u, N_st, sze)
|
||||
|
||||
end
|
||||
|
||||
subroutine htcdag_bi_ortho_calc_tdav(v, u, N_st, sze)
|
||||
subroutine htcdag_bi_ortho_calc_tdav_slow(v, u, N_st, sze)
|
||||
|
||||
use bitmasks
|
||||
|
||||
@ -71,7 +71,7 @@ subroutine htcdag_bi_ortho_calc_tdav(v, u, N_st, sze)
|
||||
|
||||
i = 1
|
||||
j = 1
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,j), N_int, htot)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,j), N_int, htot)
|
||||
|
||||
v = 0.d0
|
||||
|
||||
@ -81,7 +81,7 @@ subroutine htcdag_bi_ortho_calc_tdav(v, u, N_st, sze)
|
||||
do istate = 1, N_st
|
||||
do i = 1, sze
|
||||
do j = 1, sze
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,j), psi_det(1,1,i), N_int, htot)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,j), psi_det(1,1,i), N_int, htot)
|
||||
v(i,istate) = v(i,istate) + htot * u(j,istate)
|
||||
enddo
|
||||
enddo
|
||||
|
@ -49,12 +49,12 @@ subroutine routine
|
||||
do i = 1, N_det
|
||||
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
|
||||
if(degree == 1 .or. degree == 2)then
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i),HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i),HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
|
||||
delta_e = e_tilde_00 - e_i0
|
||||
coef_pt1 = htilde_ij / delta_e
|
||||
|
||||
call htilde_mu_mat_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
contrib_pt = coef_pt1 * htilde_ij
|
||||
e_pt2 += contrib_pt
|
||||
|
||||
|
@ -36,11 +36,11 @@ subroutine routine
|
||||
e_corr_abs = 0.d0
|
||||
e_corr_pos = 0.d0
|
||||
e_corr_neg = 0.d0
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,1), psi_det(1,1,1), N_int, e00)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,1), psi_det(1,1,1), N_int, e00)
|
||||
do i = 2, N_det
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,1), N_int, hi0)
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,1), psi_det(1,1,i), N_int, h0i)
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,i), N_int, ei)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,1), N_int, hi0)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,1), psi_det(1,1,i), N_int, h0i)
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,i), N_int, ei)
|
||||
call get_excitation_degree(psi_det(1,1,1), psi_det(1,1,i),degree,N_int)
|
||||
call get_excitation(psi_det(1,1,1), psi_det(1,1,i),exc,degree,phase,N_int)
|
||||
call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
|
||||
|
@ -1,27 +1,5 @@
|
||||
subroutine provide_all_three_ints_bi_ortho
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! routine that provides all necessary three-electron integrals
|
||||
END_DOC
|
||||
if(three_body_h_tc)then
|
||||
if(three_e_3_idx_term)then
|
||||
PROVIDE three_e_3_idx_direct_bi_ort three_e_3_idx_cycle_1_bi_ort three_e_3_idx_cycle_2_bi_ort
|
||||
PROVIDE three_e_3_idx_exch23_bi_ort three_e_3_idx_exch13_bi_ort three_e_3_idx_exch12_bi_ort
|
||||
endif
|
||||
if(three_e_4_idx_term)then
|
||||
PROVIDE three_e_4_idx_direct_bi_ort three_e_4_idx_cycle_1_bi_ort three_e_4_idx_cycle_2_bi_ort
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort three_e_4_idx_exch13_bi_ort three_e_4_idx_exch12_bi_ort
|
||||
endif
|
||||
if(.not.double_normal_ord.and.three_e_5_idx_term)then
|
||||
PROVIDE three_e_5_idx_direct_bi_ort three_e_5_idx_cycle_1_bi_ort three_e_5_idx_cycle_2_bi_ort
|
||||
PROVIDE three_e_5_idx_exch23_bi_ort three_e_5_idx_exch13_bi_ort three_e_5_idx_exch12_bi_ort
|
||||
elseif (double_normal_ord .and. (.not. three_e_5_idx_term))then
|
||||
PROVIDE normal_two_body_bi_orth
|
||||
endif
|
||||
endif
|
||||
end
|
||||
|
||||
subroutine diag_htilde_three_body_ints_bi_ort(Nint, key_i, hthree)
|
||||
subroutine diag_htilde_three_body_ints_bi_ort_slow(Nint, key_i, hthree)
|
||||
|
||||
BEGIN_DOC
|
||||
! diagonal element of htilde ONLY FOR THREE-BODY TERMS WITH BI ORTHONORMAL ORBITALS
|
||||
@ -112,7 +90,7 @@ subroutine diag_htilde_three_body_ints_bi_ort(Nint, key_i, hthree)
|
||||
end
|
||||
|
||||
|
||||
subroutine single_htilde_three_body_ints_bi_ort(Nint, key_j, key_i, hthree)
|
||||
subroutine single_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree)
|
||||
|
||||
BEGIN_DOC
|
||||
! <key_j | H_tilde | key_i> for single excitation ONLY FOR THREE-BODY TERMS WITH BI ORTHONORMAL ORBITALS
|
||||
@ -207,7 +185,7 @@ end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine double_htilde_three_body_ints_bi_ort(Nint, key_j, key_i, hthree)
|
||||
subroutine double_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree)
|
||||
|
||||
BEGIN_DOC
|
||||
! <key_j | H_tilde | key_i> for double excitation ONLY FOR THREE-BODY TERMS WITH BI ORTHONORMAL ORBITALS
|
@ -1,3 +1,26 @@
|
||||
subroutine provide_all_three_ints_bi_ortho
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! routine that provides all necessary three-electron integrals
|
||||
END_DOC
|
||||
if(three_body_h_tc)then
|
||||
if(three_e_3_idx_term)then
|
||||
PROVIDE three_e_3_idx_direct_bi_ort three_e_3_idx_cycle_1_bi_ort three_e_3_idx_cycle_2_bi_ort
|
||||
PROVIDE three_e_3_idx_exch23_bi_ort three_e_3_idx_exch13_bi_ort three_e_3_idx_exch12_bi_ort
|
||||
endif
|
||||
if(three_e_4_idx_term)then
|
||||
PROVIDE three_e_4_idx_direct_bi_ort three_e_4_idx_cycle_1_bi_ort three_e_4_idx_cycle_2_bi_ort
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort three_e_4_idx_exch13_bi_ort three_e_4_idx_exch12_bi_ort
|
||||
endif
|
||||
if(.not.double_normal_ord.and.three_e_5_idx_term)then
|
||||
PROVIDE three_e_5_idx_direct_bi_ort three_e_5_idx_cycle_1_bi_ort three_e_5_idx_cycle_2_bi_ort
|
||||
PROVIDE three_e_5_idx_exch23_bi_ort three_e_5_idx_exch13_bi_ort three_e_5_idx_exch12_bi_ort
|
||||
elseif (double_normal_ord .and. (.not. three_e_5_idx_term))then
|
||||
PROVIDE normal_two_body_bi_orth
|
||||
endif
|
||||
endif
|
||||
end
|
||||
|
||||
subroutine htilde_mu_mat_opt_bi_ortho_tot(key_j, key_i, Nint, htot)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
@ -7,11 +7,11 @@
|
||||
! Various component of the TC energy for the reference "HF" Slater determinant
|
||||
END_DOC
|
||||
double precision :: hmono, htwoe, htot, hthree
|
||||
call diag_htilde_mu_mat_bi_ortho(N_int,HF_bitmask , hmono, htwoe, htot)
|
||||
call diag_htilde_mu_mat_bi_ortho_slow(N_int,HF_bitmask , hmono, htwoe, htot)
|
||||
ref_tc_energy_1e = hmono
|
||||
ref_tc_energy_2e = htwoe
|
||||
if(three_body_h_tc)then
|
||||
call diag_htilde_three_body_ints_bi_ort(N_int, HF_bitmask, hthree)
|
||||
call diag_htilde_three_body_ints_bi_ort_slow(N_int, HF_bitmask, hthree)
|
||||
ref_tc_energy_3e = hthree
|
||||
else
|
||||
ref_tc_energy_3e = 0.d0
|
||||
|
@ -1,7 +1,7 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine htilde_mu_mat_bi_ortho_tot(key_j, key_i, Nint, htot)
|
||||
subroutine htilde_mu_mat_bi_ortho_tot_slow(key_j, key_i, Nint, htot)
|
||||
|
||||
BEGIN_DOC
|
||||
! <key_j | H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis
|
||||
@ -24,14 +24,14 @@ subroutine htilde_mu_mat_bi_ortho_tot(key_j, key_i, Nint, htot)
|
||||
if(degree.gt.2)then
|
||||
htot = 0.d0
|
||||
else
|
||||
call htilde_mu_mat_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
endif
|
||||
|
||||
end subroutine htilde_mu_mat_bi_ortho_tot
|
||||
end subroutine htilde_mu_mat_bi_ortho_tot_slow
|
||||
|
||||
! --
|
||||
|
||||
subroutine htilde_mu_mat_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
subroutine htilde_mu_mat_bi_ortho_slow(key_j, key_i, Nint, hmono, htwoe, hthree, htot)
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
@ -61,22 +61,22 @@ subroutine htilde_mu_mat_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, htot
|
||||
if(degree.gt.2) return
|
||||
|
||||
if(degree == 0)then
|
||||
call diag_htilde_mu_mat_bi_ortho(Nint, key_i, hmono, htwoe, htot)
|
||||
call diag_htilde_mu_mat_bi_ortho_slow(Nint, key_i, hmono, htwoe, htot)
|
||||
else if (degree == 1)then
|
||||
call single_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
call single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
else if(degree == 2)then
|
||||
call double_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
call double_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
endif
|
||||
|
||||
if(three_body_h_tc) then
|
||||
if(degree == 2) then
|
||||
if(.not.double_normal_ord) then
|
||||
call double_htilde_three_body_ints_bi_ort(Nint, key_j, key_i, hthree)
|
||||
if(.not.double_normal_ord.and.elec_num.gt.2.and.three_e_5_idx_term) then
|
||||
call double_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree)
|
||||
endif
|
||||
else if(degree == 1) then
|
||||
call single_htilde_three_body_ints_bi_ort(Nint, key_j, key_i, hthree)
|
||||
else if(degree == 0) then
|
||||
call diag_htilde_three_body_ints_bi_ort(Nint, key_i, hthree)
|
||||
else if(degree == 1.and.elec_num.gt.2.and.three_e_4_idx_term) then
|
||||
call single_htilde_three_body_ints_bi_ort_slow(Nint, key_j, key_i, hthree)
|
||||
else if(degree == 0.and.elec_num.gt.2.and.three_e_3_idx_term) then
|
||||
call diag_htilde_three_body_ints_bi_ort_slow(Nint, key_i, hthree)
|
||||
endif
|
||||
endif
|
||||
|
||||
@ -89,7 +89,7 @@ end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine diag_htilde_mu_mat_bi_ortho(Nint, key_i, hmono, htwoe, htot)
|
||||
subroutine diag_htilde_mu_mat_bi_ortho_slow(Nint, key_i, hmono, htwoe, htot)
|
||||
|
||||
BEGIN_DOC
|
||||
! diagonal element of htilde ONLY FOR ONE- AND TWO-BODY TERMS
|
||||
@ -188,7 +188,7 @@ end
|
||||
|
||||
|
||||
|
||||
subroutine double_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
subroutine double_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
|
||||
BEGIN_DOC
|
||||
! <key_j | H_tilde | key_i> for double excitation ONLY FOR ONE- AND TWO-BODY TERMS
|
||||
@ -227,18 +227,7 @@ subroutine double_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
return
|
||||
endif
|
||||
|
||||
! if(core_tc_op)then
|
||||
! print*,'core_tc_op not already taken into account for bi ortho'
|
||||
! print*,'stopping ...'
|
||||
! stop
|
||||
! do i = 1, Nint
|
||||
! key_i_core(i,1) = xor(key_i(i,1),core_bitmask(i,1))
|
||||
! key_i_core(i,2) = xor(key_i(i,2),core_bitmask(i,2))
|
||||
! enddo
|
||||
! call bitstring_to_list_ab(key_i_core, occ, Ne, Nint)
|
||||
! else
|
||||
call bitstring_to_list_ab(key_i, occ, Ne, Nint)
|
||||
! endif
|
||||
call get_double_excitation(key_i, key_j, exc, phase, Nint)
|
||||
call decode_exc(exc, 2, h1, p1, h2, p2, s1, s2)
|
||||
|
||||
@ -246,7 +235,7 @@ subroutine double_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
! opposite spin two-body
|
||||
! key_j, key_i
|
||||
htwoe = mo_bi_ortho_tc_two_e(p2,p1,h2,h1)
|
||||
if(double_normal_ord.and.+Ne(1).gt.2)then
|
||||
if(three_body_h_tc.and.double_normal_ord.and.+Ne(1).gt.2)then
|
||||
htwoe += normal_two_body_bi_orth(p2,h2,p1,h1)!!! WTF ???
|
||||
endif
|
||||
else
|
||||
@ -255,7 +244,7 @@ subroutine double_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
htwoe = mo_bi_ortho_tc_two_e(p2,p1,h2,h1)
|
||||
! exchange terms
|
||||
htwoe -= mo_bi_ortho_tc_two_e(p1,p2,h2,h1)
|
||||
if(double_normal_ord.and.+Ne(1).gt.2)then
|
||||
if(three_body_h_tc.and.double_normal_ord.and.+Ne(1).gt.2)then
|
||||
htwoe -= normal_two_body_bi_orth(h2,p1,h1,p2)!!! WTF ???
|
||||
htwoe += normal_two_body_bi_orth(h1,p1,h2,p2)!!! WTF ???
|
||||
endif
|
||||
@ -266,7 +255,7 @@ subroutine double_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
end
|
||||
|
||||
|
||||
subroutine single_htilde_mu_mat_bi_ortho(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
subroutine single_htilde_mu_mat_bi_ortho_slow(Nint, key_j, key_i, hmono, htwoe, htot)
|
||||
|
||||
BEGIN_DOC
|
||||
! <key_j | H_tilde | key_i> for single excitation ONLY FOR ONE- AND TWO-BODY TERMS
|
@ -11,10 +11,10 @@
|
||||
allocate(H_jj(N_det),vec_tmp(N_det,n_states_diag),eigval_tmp(N_states))
|
||||
dressing_dets = 0.d0
|
||||
do i = 1, N_det
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))
|
||||
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
|
||||
if(degree == 1 .or. degree == 2)then
|
||||
call htilde_mu_mat_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,h0j(i))
|
||||
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,h0j(i))
|
||||
endif
|
||||
enddo
|
||||
reigvec_tc_bi_orth_tmp = 0.d0
|
||||
@ -29,7 +29,7 @@
|
||||
vec_tmp(istate,istate) = 1.d0
|
||||
enddo
|
||||
print*,'Diagonalizing the TC CISD '
|
||||
call davidson_general_diag_dressed_ext_rout_nonsym_b1space(vec_tmp, H_jj, dressing_dets,eigval_tmp, N_det, n_states, n_states_diag, converged, htc_bi_ortho_calc_tdav)
|
||||
call davidson_general_diag_dressed_ext_rout_nonsym_b1space(vec_tmp, H_jj, dressing_dets,eigval_tmp, N_det, n_states, n_states_diag, converged, htc_bi_ortho_calc_tdav_slow)
|
||||
do i = 1, N_det
|
||||
e_corr_dets(i) = reigvec_tc_bi_orth_tmp(i,1) * h0j(i)/reigvec_tc_bi_orth_tmp(1,1)
|
||||
enddo
|
||||
@ -41,8 +41,8 @@
|
||||
it = 0
|
||||
dressing_dets = 0.d0
|
||||
double precision, allocatable :: H_jj(:),vec_tmp(:,:),eigval_tmp(:)
|
||||
external htc_bi_ortho_calc_tdav
|
||||
external htcdag_bi_ortho_calc_tdav
|
||||
external htc_bi_ortho_calc_tdav_slow
|
||||
external htcdag_bi_ortho_calc_tdav_slow
|
||||
logical :: converged
|
||||
do while (dabs(E_before-E_current).gt.thr)
|
||||
it += 1
|
||||
@ -66,7 +66,7 @@
|
||||
do istate = N_states+1, n_states_diag
|
||||
vec_tmp(istate,istate) = 1.d0
|
||||
enddo
|
||||
call davidson_general_diag_dressed_ext_rout_nonsym_b1space(vec_tmp, H_jj, dressing_dets,eigval_tmp, N_det, n_states, n_states_diag, converged, htc_bi_ortho_calc_tdav)
|
||||
call davidson_general_diag_dressed_ext_rout_nonsym_b1space(vec_tmp, H_jj, dressing_dets,eigval_tmp, N_det, n_states, n_states_diag, converged, htc_bi_ortho_calc_tdav_slow)
|
||||
print*,'outside Davidson'
|
||||
print*,'eigval_tmp(1) = ',eigval_tmp(1)
|
||||
do i = 1, N_det
|
||||
|
@ -207,8 +207,6 @@ end
|
||||
else ! n_det > N_det_max_full
|
||||
|
||||
double precision, allocatable :: H_jj(:),vec_tmp(:,:)
|
||||
external htc_bi_ortho_calc_tdav
|
||||
external htcdag_bi_ortho_calc_tdav
|
||||
external H_tc_u_0_opt
|
||||
external H_tc_dagger_u_0_opt
|
||||
external H_tc_s2_dagger_u_0_opt
|
||||
@ -217,7 +215,7 @@ end
|
||||
allocate(H_jj(N_det),vec_tmp(N_det,n_states_diag))
|
||||
|
||||
do i = 1, N_det
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))
|
||||
enddo
|
||||
|
||||
print*,'---------------------------------'
|
||||
@ -259,7 +257,6 @@ end
|
||||
do istate = N_states+1, n_states_diag
|
||||
vec_tmp(istate,istate) = 1.d0
|
||||
enddo
|
||||
!call davidson_general_ext_rout_nonsym_b1space(vec_tmp, H_jj, eigval_right_tc_bi_orth, N_det, n_states, n_states_diag, converged, htc_bi_ortho_calc_tdav)
|
||||
!call davidson_general_ext_rout_nonsym_b1space(vec_tmp, H_jj, eigval_right_tc_bi_orth, N_det, n_states, n_states_diag, converged, H_tc_u_0_opt)
|
||||
converged = .False.
|
||||
i_it = 0
|
||||
|
@ -56,8 +56,8 @@ subroutine main()
|
||||
U_SOM = 0.d0
|
||||
do i = 1, N_det
|
||||
if(i == i_HF) cycle
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i_HF), psi_det(1,1,i), N_int, hmono_1, htwoe_1, hthree_1, htot_1)
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i), psi_det(1,1,i_HF), N_int, hmono_2, htwoe_2, hthree_2, htot_2)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i_HF), psi_det(1,1,i), N_int, hmono_1, htwoe_1, hthree_1, htot_1)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i), psi_det(1,1,i_HF), N_int, hmono_2, htwoe_2, hthree_2, htot_2)
|
||||
U_SOM += htot_1 * htot_2
|
||||
enddo
|
||||
U_SOM = 0.5d0 * U_SOM
|
||||
|
@ -12,7 +12,7 @@ subroutine write_tc_energy()
|
||||
do i = 1, N_det
|
||||
do j = 1, N_det
|
||||
!htot = htilde_matrix_elmt_bi_ortho(i,j)
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
|
||||
E_TC = E_TC + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htot
|
||||
!E_TC = E_TC + leigvec_tc_bi_orth(i,k) * reigvec_tc_bi_orth(j,k) * htot
|
||||
enddo
|
||||
@ -45,7 +45,7 @@ subroutine write_tc_var()
|
||||
|
||||
SIGMA_TC = 0.d0
|
||||
do j = 2, N_det
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,1), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,1), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
|
||||
SIGMA_TC = SIGMA_TC + htot * htot
|
||||
enddo
|
||||
|
||||
|
@ -35,7 +35,7 @@ subroutine test
|
||||
det_i = ref_bitmask
|
||||
call do_single_excitation(det_i,h1,p1,s1,i_ok)
|
||||
call do_single_excitation(det_i,h2,p2,s2,i_ok)
|
||||
call htilde_mu_mat_bi_ortho(det_i,HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(det_i,HF_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call get_excitation_degree(ref_bitmask,det_i,degree,N_int)
|
||||
call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int)
|
||||
hthree *= phase
|
||||
@ -67,7 +67,7 @@ do h1 = 1, elec_alpha_num
|
||||
if(i_ok.ne.1)cycle
|
||||
call do_single_excitation(det_i,h2,p2,s2,i_ok)
|
||||
if(i_ok.ne.1)cycle
|
||||
call htilde_mu_mat_bi_ortho(det_i,ref_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(det_i,ref_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call get_excitation_degree(ref_bitmask,det_i,degree,N_int)
|
||||
call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int)
|
||||
integer :: hh1, pp1, hh2, pp2, ss1, ss2
|
||||
@ -103,7 +103,7 @@ do h1 = 1, elec_beta_num
|
||||
if(i_ok.ne.1)cycle
|
||||
call do_single_excitation(det_i,h2,p2,s2,i_ok)
|
||||
if(i_ok.ne.1)cycle
|
||||
call htilde_mu_mat_bi_ortho(det_i,ref_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(det_i,ref_bitmask,N_int,hmono,htwoe,hthree,htilde_ij)
|
||||
call get_excitation_degree(ref_bitmask,det_i,degree,N_int)
|
||||
call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int)
|
||||
call decode_exc(exc, 2, hh1, pp1, hh2, pp2, ss1, ss2)
|
||||
|
@ -91,7 +91,7 @@ subroutine routine_test_s2_davidson
|
||||
external H_tc_s2_u_0_opt
|
||||
allocate(H_jj(N_det),vec_tmp(N_det,n_states_diag),energies(n_states_diag), s2(n_states_diag))
|
||||
do i = 1, N_det
|
||||
call htilde_mu_mat_bi_ortho_tot(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))
|
||||
call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))
|
||||
enddo
|
||||
! Preparing the left-eigenvector
|
||||
print*,'Computing the left-eigenvector '
|
||||
|
@ -31,7 +31,7 @@ subroutine test_h_u0
|
||||
u_0(i) = psi_r_coef_bi_ortho(i,1)
|
||||
enddo
|
||||
call H_tc_u_0_nstates_openmp(v_0_new,u_0,N_states,N_det, do_right)
|
||||
call htc_bi_ortho_calc_tdav (v_0_ref,u_0,N_states,N_det)
|
||||
call htc_bi_ortho_calc_tdav_slow (v_0_ref,u_0,N_states,N_det)
|
||||
print*,'difference right '
|
||||
accu = 0.d0
|
||||
do i = 1, N_det
|
||||
@ -42,7 +42,7 @@ subroutine test_h_u0
|
||||
do_right = .False.
|
||||
v_0_new = 0.d0
|
||||
call H_tc_u_0_nstates_openmp(v_0_new,u_0,N_states,N_det, do_right)
|
||||
call htcdag_bi_ortho_calc_tdav(v_0_ref_dagger,u_0,N_states,N_det, do_right)
|
||||
call htcdag_bi_ortho_calc_tdav_slow(v_0_ref_dagger,u_0,N_states,N_det, do_right)
|
||||
print*,'difference left'
|
||||
accu = 0.d0
|
||||
do i = 1, N_det
|
||||
@ -63,7 +63,7 @@ subroutine test_slater_tc_opt
|
||||
i_count = 0.d0
|
||||
do i = 1, N_det
|
||||
do j = 1,N_det
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hnewmono, hnewtwoe, hnewthree, hnewtot)
|
||||
if(dabs(htot).gt.1.d-15)then
|
||||
i_count += 1.D0
|
||||
@ -99,7 +99,7 @@ subroutine timing_tot
|
||||
do j = 1, N_det
|
||||
! call get_excitation_degree(psi_det(1,1,j), psi_det(1,1,i),degree,N_int)
|
||||
i_count += 1.d0
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
enddo
|
||||
enddo
|
||||
call wall_time(wall1)
|
||||
@ -146,7 +146,7 @@ subroutine timing_diag
|
||||
do i = 1, N_det
|
||||
do j = i,i
|
||||
i_count += 1.d0
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
enddo
|
||||
enddo
|
||||
call wall_time(wall1)
|
||||
@ -183,7 +183,7 @@ subroutine timing_single
|
||||
if(degree.ne.1)cycle
|
||||
i_count += 1.d0
|
||||
call wall_time(wall0)
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call wall_time(wall1)
|
||||
accu += wall1 - wall0
|
||||
enddo
|
||||
@ -225,7 +225,7 @@ subroutine timing_double
|
||||
if(degree.ne.2)cycle
|
||||
i_count += 1.d0
|
||||
call wall_time(wall0)
|
||||
call htilde_mu_mat_bi_ortho(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,i), N_int, hmono, htwoe, hthree, htot)
|
||||
call wall_time(wall1)
|
||||
accu += wall1 - wall0
|
||||
enddo
|
||||
|
@ -25,8 +25,7 @@ subroutine test_3e
|
||||
implicit none
|
||||
double precision :: integral_aaa,integral_aab,integral_abb,integral_bbb,accu
|
||||
double precision :: hmono, htwoe, hthree, htot
|
||||
call htilde_mu_mat_bi_ortho(ref_bitmask, ref_bitmask, N_int, hmono, htwoe, hthree, htot)
|
||||
! call diag_htilde_three_body_ints_bi_ort(N_int, ref_bitmask, hthree)
|
||||
call htilde_mu_mat_bi_ortho_slow(ref_bitmask, ref_bitmask, N_int, hmono, htwoe, hthree, htot)
|
||||
print*,'hmono = ',hmono
|
||||
print*,'htwoe = ',htwoe
|
||||
print*,'hthree= ',hthree
|
||||
@ -88,7 +87,7 @@ subroutine routine_3()
|
||||
print*, ' excited det'
|
||||
call debug_det(det_i, N_int)
|
||||
|
||||
call htilde_mu_mat_bi_ortho(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij)
|
||||
if(dabs(hthree).lt.1.d-10)cycle
|
||||
ref = hthree
|
||||
if(s1 == 1)then
|
||||
@ -156,7 +155,7 @@ subroutine routine_tot()
|
||||
stop
|
||||
endif
|
||||
|
||||
call htilde_mu_mat_bi_ortho(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij)
|
||||
call htilde_mu_mat_bi_ortho_slow(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij)
|
||||
print*,htilde_ij
|
||||
if(dabs(htilde_ij).lt.1.d-10)cycle
|
||||
print*, ' excited det'
|
||||
|
Loading…
Reference in New Issue
Block a user