PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-19 19:52:20 +02:00
Code Releases Activity

still not compiling

Browse Source
This commit is contained in:
eginer 2024-05-06 18:33:29 +02:00
parent 109a956f0d
commit b749796d93
9 changed files with 35 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
plugins/local/tc_bi_ortho/dressing_vectors_lr.irp.f
View File

@ -27,7 +27,7 @@ subroutine get_delta_bitc_right(psidet, psicoef, ndet, Nint, delta)
i = 1 i = 1
j = 1 j = 1
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 htilde_mu_mat_opt_bi_ortho(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) call hmat_bi_ortho (psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot)
delta = 0.d0 delta = 0.d0
@ -39,7 +39,7 @@ subroutine get_delta_bitc_right(psidet, psicoef, ndet, Nint, delta)
do j = 1, ndet do j = 1, ndet
! < I |Htilde | J > ! < I |Htilde | J >
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 htilde_mu_mat_opt_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
! < I |H | J > ! < I |H | J >
call hmat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, h_mono, h_twoe, h_tot) 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 i = 1
j = 1 j = 1
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 htilde_mu_mat_opt_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
delta = 0.d0 delta = 0.d0
!$OMP PARALLEL DO DEFAULT(NONE) SCHEDULE(dynamic,8) & !$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 do j = 1, ndet
! < I |Htilde | J > ! < I |Htilde | J >
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 htilde_mu_mat_opt_bi_ortho(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 delta(i) = delta(i) + psicoef(j) * htc_tot
enddo enddo

18
plugins/local/tc_bi_ortho/e_corr_bi_ortho.irp.f
View File

@ -2,7 +2,7 @@
BEGIN_PROVIDER [ double precision, e_tilde_00] BEGIN_PROVIDER [ double precision, e_tilde_00]
implicit none implicit none
double precision :: hmono,htwoe,hthree,htot double precision :: hmono,htwoe,hthree,htot
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,htot) call htilde_mu_mat_opt_bi_ortho(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,htot)
e_tilde_00 = htot e_tilde_00 = htot
END_PROVIDER END_PROVIDER
@ -18,11 +18,11 @@
do i = 1, N_det do i = 1, N_det
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int) call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
if(degree == 1 .or. degree == 2)then if(degree == 1 .or. degree == 2)then
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_opt_bi_ortho(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) call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
delta_e = e_tilde_00 - e_i0 delta_e = e_tilde_00 - e_i0
coef_pt1 = htilde_ij / delta_e coef_pt1 = htilde_ij / delta_e
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij) call htilde_mu_mat_opt_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
e_pt2_tc_bi_orth += coef_pt1 * htilde_ij e_pt2_tc_bi_orth += coef_pt1 * htilde_ij
if(degree == 1)then if(degree == 1)then
e_pt2_tc_bi_orth_single += coef_pt1 * htilde_ij e_pt2_tc_bi_orth_single += coef_pt1 * htilde_ij
@ -37,7 +37,7 @@
BEGIN_PROVIDER [ double precision, e_tilde_bi_orth_00] BEGIN_PROVIDER [ double precision, e_tilde_bi_orth_00]
implicit none implicit none
double precision :: hmono,htwoe,hthree,htilde_ij double precision :: hmono,htwoe,hthree,htilde_ij
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,e_tilde_bi_orth_00) call htilde_mu_mat_opt_bi_ortho(HF_bitmask,HF_bitmask,N_int,hmono,htwoe,hthree,e_tilde_bi_orth_00)
e_tilde_bi_orth_00 += nuclear_repulsion e_tilde_bi_orth_00 += nuclear_repulsion
END_PROVIDER END_PROVIDER
@ -57,7 +57,7 @@
e_corr_double_bi_orth = 0.d0 e_corr_double_bi_orth = 0.d0
do i = 1, N_det do i = 1, N_det
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int) call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij) call htilde_mu_mat_opt_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
if(degree == 1)then 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 += 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)) 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 do i = 1, N_det
accu += reigvec_tc_bi_orth(i,1) * leigvec_tc_bi_orth(i,1) accu += reigvec_tc_bi_orth(i,1) * leigvec_tc_bi_orth(i,1)
do j = 1, N_det do j = 1, N_det
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j),psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij) call htilde_mu_mat_opt_bi_ortho(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) e_tc_left_right += htilde_ij * reigvec_tc_bi_orth(i,1) * leigvec_tc_bi_orth(j,1)
enddo enddo
enddo enddo
@ -99,8 +99,8 @@ BEGIN_PROVIDER [ double precision, coef_pt1_bi_ortho, (N_det)]
if(degree==0)then if(degree==0)then
coef_pt1_bi_ortho(i) = 1.d0 coef_pt1_bi_ortho(i) = 1.d0
else else
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_opt_bi_ortho(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) call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
delta_e = e_tilde_00 - e_i0 delta_e = e_tilde_00 - e_i0
coef_pt1 = htilde_ij / delta_e coef_pt1 = htilde_ij / delta_e
coef_pt1_bi_ortho(i)= coef_pt1 coef_pt1_bi_ortho(i)= coef_pt1

6
plugins/local/tc_bi_ortho/print_tc_wf.irp.f
View File

@ -61,12 +61,12 @@ subroutine routine
do i = 1, N_det do i = 1, N_det
call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int) call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
if(degree == 1 .or. degree == 2)then if(degree == 1 .or. degree == 2)then
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_opt_bi_ortho(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) call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,i),psi_det(1,1,i),N_int,hmono,htwoe,hthree,e_i0)
delta_e = e_tilde_00 - e_i0 delta_e = e_tilde_00 - e_i0
coef_pt1 = htilde_ij / delta_e coef_pt1 = htilde_ij / delta_e
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij) call htilde_mu_mat_opt_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,htilde_ij)
contrib_pt = coef_pt1 * htilde_ij contrib_pt = coef_pt1 * htilde_ij
e_pt2 += contrib_pt e_pt2 += contrib_pt

2
plugins/local/tc_bi_ortho/tc_cisd_sc2_utils.irp.f
View File

@ -14,7 +14,7 @@
call htilde_mu_mat_bi_ortho_tot_slow(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) call get_excitation_degree(HF_bitmask,psi_det(1,1,i),degree,N_int)
if(degree == 1 .or. degree == 2)then if(degree == 1 .or. degree == 2)then
call htilde_mu_mat_bi_ortho_slow(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,h0j(i)) call htilde_mu_mat_opt_bi_ortho(HF_bitmask,psi_det(1,1,i),N_int,hmono,htwoe,hthree,h0j(i))
endif endif
enddo enddo
reigvec_tc_bi_orth_tmp = 0.d0 reigvec_tc_bi_orth_tmp = 0.d0

4
plugins/local/tc_bi_ortho/tc_som.irp.f
View File

@ -49,8 +49,8 @@ subroutine main()
U_SOM = 0.d0 U_SOM = 0.d0
do i = 1, N_det do i = 1, N_det
if(i == i_HF) cycle if(i == i_HF) cycle
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_opt_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_slow(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_opt_bi_ortho(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 U_SOM += htot_1 * htot_2
enddo enddo
U_SOM = 0.5d0 * U_SOM U_SOM = 0.5d0 * U_SOM

10
plugins/local/tc_bi_ortho/tc_utils.irp.f
View File

@ -25,7 +25,7 @@ subroutine write_tc_energy()
E_2e_tmp(i) = 0.d0 E_2e_tmp(i) = 0.d0
E_3e_tmp(i) = 0.d0 E_3e_tmp(i) = 0.d0
do j = 1, N_det do j = 1, N_det
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot) call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot)
E_TC_tmp(i) = E_TC_tmp(i) + psi_l_coef_bi_ortho(i,1) * psi_r_coef_bi_ortho(j,1) * htot E_TC_tmp(i) = E_TC_tmp(i) + psi_l_coef_bi_ortho(i,1) * psi_r_coef_bi_ortho(j,1) * htot
E_1e_tmp(i) = E_1e_tmp(i) + psi_l_coef_bi_ortho(i,1) * psi_r_coef_bi_ortho(j,1) * hmono E_1e_tmp(i) = E_1e_tmp(i) + psi_l_coef_bi_ortho(i,1) * psi_r_coef_bi_ortho(j,1) * hmono
E_2e_tmp(i) = E_2e_tmp(i) + psi_l_coef_bi_ortho(i,1) * psi_r_coef_bi_ortho(j,1) * htwoe E_2e_tmp(i) = E_2e_tmp(i) + psi_l_coef_bi_ortho(i,1) * psi_r_coef_bi_ortho(j,1) * htwoe
@ -70,7 +70,7 @@ subroutine write_tc_energy()
E_3e = 0.d0 E_3e = 0.d0
do i = 1, N_det do i = 1, N_det
do j = 1, N_det do j = 1, N_det
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,i), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot) call htilde_mu_mat_opt_bi_ortho(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 + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htot
E_1e = E_1e + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * hmono E_1e = E_1e + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * hmono
E_2e = E_2e + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htwoe E_2e = E_2e + psi_l_coef_bi_ortho(i,k) * psi_r_coef_bi_ortho(j,k) * htwoe
@ -109,8 +109,8 @@ subroutine write_tc_var()
SIGMA_TC = 0.d0 SIGMA_TC = 0.d0
do j = 2, N_det do j = 2, N_det
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,1), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot_1j) call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,1), psi_det(1,1,j), N_int, hmono, htwoe, hthree, htot_1j)
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,1), N_int, hmono, htwoe, hthree, htot_j1) call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,j), psi_det(1,1,1), N_int, hmono, htwoe, hthree, htot_j1)
SIGMA_TC = SIGMA_TC + htot_1j * htot_j1 SIGMA_TC = SIGMA_TC + htot_1j * htot_j1
enddo enddo
@ -132,7 +132,7 @@ subroutine write_tc_gs_var_HF()
SIGMA_TC = 0.d0 SIGMA_TC = 0.d0
do j = 2, N_det do j = 2, N_det
call htilde_mu_mat_bi_ortho_slow(psi_det(1,1,j), psi_det(1,1,1), N_int, hmono, htwoe, hthree, htot) call htilde_mu_mat_opt_bi_ortho(psi_det(1,1,j), psi_det(1,1,1), N_int, hmono, htwoe, hthree, htot)
SIGMA_TC = SIGMA_TC + htot * htot SIGMA_TC = SIGMA_TC + htot * htot
enddo enddo

8
plugins/local/tc_bi_ortho/test_normal_order.irp.f
View File

@ -54,7 +54,7 @@ subroutine test
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call do_single_excitation(det_i,h2,p2,s2,i_ok) call do_single_excitation(det_i,h2,p2,s2,i_ok)
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call htilde_mu_mat_bi_ortho_slow(det_i,HF_bitmask,N_int,hmono,htwoe,hthree_tmp,htilde_ij) call htilde_mu_mat_opt_bi_ortho(det_i,HF_bitmask,N_int,hmono,htwoe,hthree_tmp,htilde_ij)
call get_excitation_degree(ref_bitmask,det_i,degree,N_int) call get_excitation_degree(ref_bitmask,det_i,degree,N_int)
call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int) call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int)
hthree_tmp *= phase hthree_tmp *= phase
@ -66,7 +66,7 @@ subroutine test
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call do_single_excitation(det_i,h2,p2,s2,i_ok) call do_single_excitation(det_i,h2,p2,s2,i_ok)
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call htilde_mu_mat_bi_ortho_slow(det_i,HF_bitmask,N_int,hmono,htwoe,hthree_tmp,htilde_ij) call htilde_mu_mat_opt_bi_ortho(det_i,HF_bitmask,N_int,hmono,htwoe,hthree_tmp,htilde_ij)
call get_excitation_degree(ref_bitmask,det_i,degree,N_int) call get_excitation_degree(ref_bitmask,det_i,degree,N_int)
call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int) call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int)
hthree_tmp *= phase hthree_tmp *= phase
@ -109,7 +109,7 @@ do h1 = 1, elec_alpha_num
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call do_single_excitation(det_i,h2,p2,s2,i_ok) call do_single_excitation(det_i,h2,p2,s2,i_ok)
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call htilde_mu_mat_bi_ortho_slow(det_i,ref_bitmask,N_int,hmono,htwoe,hthree,htilde_ij) call htilde_mu_mat_opt_bi_ortho(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_degree(ref_bitmask,det_i,degree,N_int)
call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int) call get_excitation(ref_bitmask,det_i,exc,degree,phase,N_int)
integer :: hh1, pp1, hh2, pp2, ss1, ss2 integer :: hh1, pp1, hh2, pp2, ss1, ss2
@ -145,7 +145,7 @@ do h1 = 1, elec_beta_num
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call do_single_excitation(det_i,h2,p2,s2,i_ok) call do_single_excitation(det_i,h2,p2,s2,i_ok)
if(i_ok.ne.1)cycle if(i_ok.ne.1)cycle
call htilde_mu_mat_bi_ortho_slow(det_i,ref_bitmask,N_int,hmono,htwoe,hthree,htilde_ij) call htilde_mu_mat_opt_bi_ortho(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_degree(ref_bitmask,det_i,degree,N_int)
call get_excitation(ref_bitmask,det_i,exc,degree,phase,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) call decode_exc(exc, 2, hh1, pp1, hh2, pp2, ss1, ss2)

10
plugins/local/tc_bi_ortho/test_tc_bi_ortho.irp.f
View File

@ -88,7 +88,7 @@ subroutine test_slater_tc_opt
i_count = 0.d0 i_count = 0.d0
do i = 1, N_det do i = 1, N_det
do j = 1,N_det do j = 1,N_det
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, 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) 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 if(dabs(htot).gt.1.d-15)then
i_count += 1.D0 i_count += 1.D0
@ -124,7 +124,7 @@ subroutine timing_tot
do j = 1, N_det do j = 1, N_det
! call get_excitation_degree(psi_det(1,1,j), psi_det(1,1,i),degree,N_int) ! call get_excitation_degree(psi_det(1,1,j), psi_det(1,1,i),degree,N_int)
i_count += 1.d0 i_count += 1.d0
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, hmono, htwoe, hthree, htot)
enddo enddo
enddo enddo
call wall_time(wall1) call wall_time(wall1)
@ -171,7 +171,7 @@ subroutine timing_diag
do i = 1, N_det do i = 1, N_det
do j = i,i do j = i,i
i_count += 1.d0 i_count += 1.d0
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, hmono, htwoe, hthree, htot)
enddo enddo
enddo enddo
call wall_time(wall1) call wall_time(wall1)
@ -208,7 +208,7 @@ subroutine timing_single
if(degree.ne.1)cycle if(degree.ne.1)cycle
i_count += 1.d0 i_count += 1.d0
call wall_time(wall0) call wall_time(wall0)
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, hmono, htwoe, hthree, htot)
call wall_time(wall1) call wall_time(wall1)
accu += wall1 - wall0 accu += wall1 - wall0
enddo enddo
@ -250,7 +250,7 @@ subroutine timing_double
if(degree.ne.2)cycle if(degree.ne.2)cycle
i_count += 1.d0 i_count += 1.d0
call wall_time(wall0) call wall_time(wall0)
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, hmono, htwoe, hthree, htot)
call wall_time(wall1) call wall_time(wall1)
accu += wall1 - wall0 accu += wall1 - wall0
enddo enddo

4
plugins/local/tc_bi_ortho/test_tc_fock.irp.f
View File

@ -64,7 +64,7 @@ subroutine routine_3()
print*, ' excited det' print*, ' excited det'
call debug_det(det_i, N_int) call debug_det(det_i, N_int)
call htilde_mu_mat_bi_ortho_slow(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij) call htilde_mu_mat_opt_bi_ortho(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij)
if(dabs(hthree).lt.1.d-10)cycle if(dabs(hthree).lt.1.d-10)cycle
ref = hthree ref = hthree
if(s1 == 1)then if(s1 == 1)then
@ -130,7 +130,7 @@ subroutine routine_tot()
stop stop
endif endif
call htilde_mu_mat_bi_ortho_slow(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij) call htilde_mu_mat_opt_bi_ortho(det_i, ref_bitmask, N_int, hmono, htwoe, hthree, htilde_ij)
print*,htilde_ij print*,htilde_ij
! if(dabs(htilde_ij).lt.1.d-10)cycle ! if(dabs(htilde_ij).lt.1.d-10)cycle
print*, ' excited det' print*, ' excited det'