From 19b9976d134ceee49dc3afe180d3de8ae0dede96 Mon Sep 17 00:00:00 2001 From: AbdAmmar Date: Tue, 12 Sep 2023 20:43:54 +0200 Subject: [PATCH] noL dredding --- src/bi_ort_ints/one_e_bi_ort.irp.f | 7 ++- src/bi_ort_ints/total_twoe_pot.irp.f | 6 +++ src/tc_bi_ortho/no_dressing_naive.irp.f | 54 ++++++++++++------------ src/tc_bi_ortho/no_dressing_v0.irp.f | 54 ++++++++++++------------ src/tc_bi_ortho/slater_tc_opt.irp.f | 6 ++- src/tc_bi_ortho/slater_tc_opt_diag.irp.f | 10 +++++ src/tc_bi_ortho/test_tc_bi_ortho.irp.f | 24 +++++------ src/tc_keywords/EZFIO.cfg | 6 +++ 8 files changed, 98 insertions(+), 69 deletions(-) diff --git a/src/bi_ort_ints/one_e_bi_ort.irp.f b/src/bi_ort_ints/one_e_bi_ort.irp.f index 49181182..7c2ac860 100644 --- a/src/bi_ort_ints/one_e_bi_ort.irp.f +++ b/src/bi_ort_ints/one_e_bi_ort.irp.f @@ -29,7 +29,7 @@ END_PROVIDER ! --- -BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)] +BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)] BEGIN_DOC ! @@ -41,6 +41,11 @@ BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)] call ao_to_mo_bi_ortho(ao_one_e_integrals_tc_tot, ao_num, mo_bi_ortho_tc_one_e, mo_num) + if(noL_standard) then + PROVIDE noL_1e + mo_bi_ortho_tc_one_e = mo_bi_ortho_tc_one_e + noL_1e + endif + END_PROVIDER ! --- diff --git a/src/bi_ort_ints/total_twoe_pot.irp.f b/src/bi_ort_ints/total_twoe_pot.irp.f index f03e8a34..49f613b5 100644 --- a/src/bi_ort_ints/total_twoe_pot.irp.f +++ b/src/bi_ort_ints/total_twoe_pot.irp.f @@ -256,6 +256,12 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num, FREE mo_bi_ortho_tc_two_e_chemist + if(noL_standard) then + PROVIDE noL_2e + mo_bi_ortho_tc_two_e = mo_bi_ortho_tc_two_e + noL_2e + FREE noL_2e + endif + END_PROVIDER ! --- diff --git a/src/tc_bi_ortho/no_dressing_naive.irp.f b/src/tc_bi_ortho/no_dressing_naive.irp.f index a57b1723..a0c488b3 100644 --- a/src/tc_bi_ortho/no_dressing_naive.irp.f +++ b/src/tc_bi_ortho/no_dressing_naive.irp.f @@ -1,7 +1,7 @@ ! --- -BEGIN_PROVIDER [double precision, no_0_naive] +BEGIN_PROVIDER [double precision, noL_0e_naive] implicit none integer :: ii, jj, kk @@ -11,7 +11,7 @@ BEGIN_PROVIDER [double precision, no_0_naive] double precision :: t0, t1 double precision, allocatable :: tmp(:) - print*, " Providing no_0_naive ..." + print*, " Providing noL_0e_naive ..." call wall_time(t0) allocate(tmp(elec_num)) @@ -89,24 +89,24 @@ BEGIN_PROVIDER [double precision, no_0_naive] !$OMP END DO !$OMP END PARALLEL - no_0_naive = -1.d0 * (-sum(tmp)) / 6.d0 + noL_0e_naive = -1.d0 * (-sum(tmp)) / 6.d0 deallocate(tmp) call wall_time(t1) - print*, " Wall time for no_0_naive (min) = ", (t1 - t0)/60.d0 + print*, " Wall time for noL_0e_naive (min) = ", (t1 - t0)/60.d0 - print*, " no_0_naive = ", no_0_naive + print*, " noL_0e_naive = ", noL_0e_naive END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, no_1_naive, (mo_num, mo_num)] +BEGIN_PROVIDER [double precision, noL_1e_naive, (mo_num, mo_num)] BEGIN_DOC ! - ! < p | H(1) | s > is dressed with no_1_naive(p,s) + ! < p | H(1) | s > is dressed with noL_1e_naive(p,s) ! END_DOC @@ -117,7 +117,7 @@ BEGIN_PROVIDER [double precision, no_1_naive, (mo_num, mo_num)] double precision :: I_pij_sji, I_pij_sij, I_pij_jis, I_pij_ijs, I_pij_isj, I_pij_jsi double precision :: t0, t1 - print*, " Providing no_1_naive ..." + print*, " Providing noL_1e_naive ..." call wall_time(t0) ! ---- @@ -132,14 +132,14 @@ BEGIN_PROVIDER [double precision, no_1_naive, (mo_num, mo_num)] !$OMP I_pij_sji, I_pij_sij, I_pij_jis, & !$OMP I_pij_ijs, I_pij_isj, I_pij_jsi ) & !$OMP SHARED (mo_num, elec_beta_num, elec_num, & - !$OMP sigma_p, sigma_s, no_1_naive) + !$OMP sigma_p, sigma_s, noL_1e_naive) !$OMP DO COLLAPSE (2) do s = 1, mo_num do p = 1, mo_num - no_1_naive(p,s) = 0.d0 + noL_1e_naive(p,s) = 0.d0 do ii = 1, elec_num if(ii .le. elec_beta_num) then i = ii @@ -184,7 +184,7 @@ BEGIN_PROVIDER [double precision, no_1_naive, (mo_num, mo_num)] ! x (-1) because integrals are over -L ! x 0.5 because we consider 0.5 (up + down) - no_1_naive(p,s) = no_1_naive(p,s) + 0.25d0 * (I_pij_sji - I_pij_sij + I_pij_jis - I_pij_ijs + I_pij_isj - I_pij_jsi) + noL_1e_naive(p,s) = noL_1e_naive(p,s) + 0.25d0 * (I_pij_sji - I_pij_sij + I_pij_jis - I_pij_ijs + I_pij_isj - I_pij_jsi) enddo ! j enddo ! i enddo ! s @@ -205,7 +205,7 @@ BEGIN_PROVIDER [double precision, no_1_naive, (mo_num, mo_num)] !$OMP I_pij_sji, I_pij_sij, I_pij_jis, & !$OMP I_pij_ijs, I_pij_isj, I_pij_jsi ) & !$OMP SHARED (mo_num, elec_beta_num, elec_num, & - !$OMP sigma_p, sigma_s, no_1_naive) + !$OMP sigma_p, sigma_s, noL_1e_naive) !$OMP DO COLLAPSE (2) @@ -256,7 +256,7 @@ BEGIN_PROVIDER [double precision, no_1_naive, (mo_num, mo_num)] ! x (-1) because integrals are over -L ! x 0.5 because we consider 0.5 (up + down) - no_1_naive(p,s) = no_1_naive(p,s) + 0.25d0 * (I_pij_sji - I_pij_sij + I_pij_jis - I_pij_ijs + I_pij_isj - I_pij_jsi) + noL_1e_naive(p,s) = noL_1e_naive(p,s) + 0.25d0 * (I_pij_sji - I_pij_sij + I_pij_jis - I_pij_ijs + I_pij_isj - I_pij_jsi) enddo ! j enddo ! i enddo ! s @@ -267,17 +267,17 @@ BEGIN_PROVIDER [double precision, no_1_naive, (mo_num, mo_num)] ! --- call wall_time(t1) - print*, " Wall time for no_1_naive (min) = ", (t1 - t0)/60.d0 + print*, " Wall time for noL_1e_naive (min) = ", (t1 - t0)/60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] +BEGIN_PROVIDER [double precision, noL_2e_naive, (mo_num, mo_num, mo_num, mo_num)] BEGIN_DOC ! - ! < p q | H(2) | s t > is dressed with no_2_naive(p,q,s,t) + ! < p q | H(2) | s t > is dressed with noL_2e_naive(p,q,s,t) ! END_DOC @@ -288,7 +288,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] double precision :: I_ipq_ist, I_ipq_sit, I_ipq_tsi double precision :: t0, t1 - print*, " Providing no_2_naive ..." + print*, " Providing noL_2e_naive ..." call wall_time(t0) ! ---- @@ -305,7 +305,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] !$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) & !$OMP SHARED (mo_num, elec_beta_num, elec_num, & !$OMP sigma_p, sigma_q, sigma_s, sigma_t, & - !$OMP no_2_naive) + !$OMP noL_2e_naive) !$OMP DO COLLAPSE (4) do t = 1, mo_num @@ -313,7 +313,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] do q = 1, mo_num do p = 1, mo_num - no_2_naive(p,q,s,t) = 0.d0 + noL_2e_naive(p,q,s,t) = 0.d0 do ii = 1, elec_num if(ii .le. elec_beta_num) then i = ii @@ -337,7 +337,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] ! x (-1) because integrals are over -L ! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down) - no_2_naive(p,q,s,t) = no_2_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) + noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) enddo ! i enddo ! p enddo ! q @@ -360,7 +360,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] !$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) & !$OMP SHARED (mo_num, elec_beta_num, elec_num, & !$OMP sigma_p, sigma_q, sigma_s, sigma_t, & - !$OMP no_2_naive) + !$OMP noL_2e_naive) !$OMP DO COLLAPSE (4) do t = 1, mo_num @@ -391,7 +391,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] ! x (-1) because integrals are over -L ! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down) - no_2_naive(p,q,s,t) = no_2_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) + noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) enddo ! i enddo ! p enddo ! q @@ -414,7 +414,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] !$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) & !$OMP SHARED (mo_num, elec_beta_num, elec_num, & !$OMP sigma_p, sigma_q, sigma_s, sigma_t, & - !$OMP no_2_naive) + !$OMP noL_2e_naive) !$OMP DO COLLAPSE (4) do t = 1, mo_num @@ -445,7 +445,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] ! x (-1) because integrals are over -L ! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down) - no_2_naive(p,q,s,t) = no_2_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) + noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) enddo ! i enddo ! p enddo ! q @@ -468,7 +468,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] !$OMP I_ipq_ist, I_ipq_sit, I_ipq_tsi) & !$OMP SHARED (mo_num, elec_beta_num, elec_num, & !$OMP sigma_p, sigma_q, sigma_s, sigma_t, & - !$OMP no_2_naive) + !$OMP noL_2e_naive) !$OMP DO COLLAPSE (4) do t = 1, mo_num @@ -499,7 +499,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] ! x (-1) because integrals are over -L ! x 0.25 because we consider 0.25 (up-up + up-down + down-up + down-down) - no_2_naive(p,q,s,t) = no_2_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) + noL_2e_naive(p,q,s,t) = noL_2e_naive(p,q,s,t) + 0.125d0 * (I_ipq_ist - I_ipq_sit - I_ipq_tsi) enddo ! i enddo ! p enddo ! q @@ -509,7 +509,7 @@ BEGIN_PROVIDER [double precision, no_2_naive, (mo_num, mo_num, mo_num, mo_num)] !$OMP END PARALLEL call wall_time(t1) - print*, " Wall time for no_2_naive (min) = ", (t1 - t0)/60.d0 + print*, " Wall time for noL_2e_naive (min) = ", (t1 - t0)/60.d0 END_PROVIDER diff --git a/src/tc_bi_ortho/no_dressing_v0.irp.f b/src/tc_bi_ortho/no_dressing_v0.irp.f index 4d40c76f..efcf51db 100644 --- a/src/tc_bi_ortho/no_dressing_v0.irp.f +++ b/src/tc_bi_ortho/no_dressing_v0.irp.f @@ -1,7 +1,7 @@ ! --- -BEGIN_PROVIDER [double precision, no_0_v0] +BEGIN_PROVIDER [double precision, noL_0e] implicit none integer :: i, j, k @@ -10,7 +10,7 @@ BEGIN_PROVIDER [double precision, no_0_v0] double precision, allocatable :: tmp(:) call wall_time(t0) - print*, " Providing no_0_v0 ..." + print*, " Providing noL_0e ..." if(elec_alpha_num .eq. elec_beta_num) then @@ -40,7 +40,7 @@ BEGIN_PROVIDER [double precision, no_0_v0] !$OMP END DO !$OMP END PARALLEL - no_0_v0 = -1.d0 * (-sum(tmp)) / 6.d0 + noL_0e = -1.d0 * (-sum(tmp)) / 6.d0 deallocate(tmp) @@ -114,22 +114,22 @@ BEGIN_PROVIDER [double precision, no_0_v0] !$OMP END DO !$OMP END PARALLEL - no_0_v0 = -1.d0 * (-sum(tmp)) / 6.d0 + noL_0e = -1.d0 * (-sum(tmp)) / 6.d0 deallocate(tmp) endif call wall_time(t1) - print*, " Wall time for no_0_v0 (min) = ", (t1 - t0)/60.d0 + print*, " Wall time for noL_0e (min) = ", (t1 - t0)/60.d0 - print*, " no_0_v0 = ", no_0_v0 + print*, " noL_0e = ", noL_0e END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] +BEGIN_PROVIDER [double precision, noL_1e, (mo_num, mo_num)] BEGIN_DOC ! @@ -143,7 +143,7 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] double precision :: t0, t1 call wall_time(t0) - print*, " Providing no_1_v0 ..." + print*, " Providing noL_1e ..." if(elec_alpha_num .eq. elec_beta_num) then @@ -152,13 +152,13 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] !$OMP PRIVATE (p, s, i, j, & !$OMP I_pij_sij, I_pij_isj, I_pij_ijs, & !$OMP I_pij_sji) & - !$OMP SHARED (mo_num, elec_beta_num, no_1_v0) + !$OMP SHARED (mo_num, elec_beta_num, noL_1e) !$OMP DO COLLAPSE(2) do s = 1, mo_num do p = 1, mo_num - no_1_v0(p,s) = 0.d0 + noL_1e(p,s) = 0.d0 do i = 1, elec_beta_num do j = 1, elec_beta_num @@ -167,7 +167,7 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs) call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji) - no_1_v0(p,s) = no_1_v0(p,s) - (2.d0*I_pij_sij - 2.d0*I_pij_isj + I_pij_ijs - I_pij_sji) + noL_1e(p,s) = noL_1e(p,s) - (2.d0*I_pij_sij - 2.d0*I_pij_isj + I_pij_ijs - I_pij_sji) enddo enddo enddo @@ -182,13 +182,13 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] !$OMP PRIVATE (p, s, i, j, & !$OMP I_pij_sij, I_pij_isj, I_pij_ijs, & !$OMP I_pij_sji, I_pij_jsi, I_pij_jis) & - !$OMP SHARED (mo_num, elec_beta_num, elec_alpha_num, no_1_v0) + !$OMP SHARED (mo_num, elec_beta_num, elec_alpha_num, noL_1e) !$OMP DO COLLAPSE(2) do s = 1, mo_num do p = 1, mo_num - no_1_v0(p,s) = 0.d0 + noL_1e(p,s) = 0.d0 do i = 1, elec_beta_num do j = 1, elec_beta_num @@ -197,7 +197,7 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs) call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji) - no_1_v0(p,s) = no_1_v0(p,s) - (2.d0*I_pij_sij - 2.d0*I_pij_isj + I_pij_ijs - I_pij_sji) + noL_1e(p,s) = noL_1e(p,s) - (2.d0*I_pij_sij - 2.d0*I_pij_isj + I_pij_ijs - I_pij_sji) enddo ! j enddo ! i @@ -211,7 +211,7 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] call give_integrals_3_body_bi_ort(p, i, j, i, s, j, I_pij_isj) call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs) - no_1_v0(p,s) = no_1_v0(p,s) + 0.5d0 * (2.d0*I_pij_sji - I_pij_jsi + 2.d0*I_pij_jis - 4.d0*I_pij_sij + 2.d0*I_pij_isj - I_pij_ijs) + noL_1e(p,s) = noL_1e(p,s) + 0.5d0 * (2.d0*I_pij_sji - I_pij_jsi + 2.d0*I_pij_jis - 4.d0*I_pij_sij + 2.d0*I_pij_isj - I_pij_ijs) enddo ! j do j = elec_beta_num+1, elec_alpha_num @@ -221,7 +221,7 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] call give_integrals_3_body_bi_ort(p, i, j, i, j, s, I_pij_ijs) call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji) - no_1_v0(p,s) = no_1_v0(p,s) - 0.5d0 * (I_pij_sij - I_pij_isj + I_pij_ijs - I_pij_sji) + noL_1e(p,s) = noL_1e(p,s) - 0.5d0 * (I_pij_sij - I_pij_isj + I_pij_ijs - I_pij_sji) enddo ! j enddo ! i @@ -233,13 +233,13 @@ BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)] endif call wall_time(t1) - print*, " Wall time for no_1_v0 (min) = ", (t1 - t0)/60.d0 + print*, " Wall time for noL_1e (min) = ", (t1 - t0)/60.d0 END_PROVIDER ! --- -BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] +BEGIN_PROVIDER [double precision, noL_2e, (mo_num, mo_num, mo_num, mo_num)] BEGIN_DOC ! @@ -253,7 +253,7 @@ BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] double precision :: t0, t1 call wall_time(t0) - print*, " Providing no_2_v0 ..." + print*, " Providing noL_2e ..." if(elec_alpha_num .eq. elec_beta_num) then @@ -261,7 +261,7 @@ BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] !$OMP DEFAULT (NONE) & !$OMP PRIVATE (p, q, s, t, i, & !$OMP I_ipq_sit, I_ipq_tsi, I_ipq_ist) & - !$OMP SHARED (mo_num, elec_beta_num, no_2_v0) + !$OMP SHARED (mo_num, elec_beta_num, noL_2e) !$OMP DO COLLAPSE(4) do t = 1, mo_num @@ -269,14 +269,14 @@ BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] do q = 1, mo_num do p = 1, mo_num - no_2_v0(p,q,s,t) = 0.d0 + noL_2e(p,q,s,t) = 0.d0 do i = 1, elec_beta_num call give_integrals_3_body_bi_ort(i, p, q, s, i, t, I_ipq_sit) call give_integrals_3_body_bi_ort(i, p, q, t, s, i, I_ipq_tsi) call give_integrals_3_body_bi_ort(i, p, q, i, s, t, I_ipq_ist) - no_2_v0(p,q,s,t) = no_2_v0(p,q,s,t) - 0.5d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist) + noL_2e(p,q,s,t) = noL_2e(p,q,s,t) - 0.5d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist) enddo enddo enddo @@ -291,7 +291,7 @@ BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] !$OMP DEFAULT (NONE) & !$OMP PRIVATE (p, q, s, t, i, & !$OMP I_ipq_sit, I_ipq_tsi, I_ipq_ist) & - !$OMP SHARED (mo_num, elec_beta_num, elec_alpha_num, no_2_v0) + !$OMP SHARED (mo_num, elec_beta_num, elec_alpha_num, noL_2e) !$OMP DO COLLAPSE(4) do t = 1, mo_num @@ -299,14 +299,14 @@ BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] do q = 1, mo_num do p = 1, mo_num - no_2_v0(p,q,s,t) = 0.d0 + noL_2e(p,q,s,t) = 0.d0 do i = 1, elec_beta_num call give_integrals_3_body_bi_ort(i, p, q, s, i, t, I_ipq_sit) call give_integrals_3_body_bi_ort(i, p, q, t, s, i, I_ipq_tsi) call give_integrals_3_body_bi_ort(i, p, q, i, s, t, I_ipq_ist) - no_2_v0(p,q,s,t) = no_2_v0(p,q,s,t) - 0.5d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist) + noL_2e(p,q,s,t) = noL_2e(p,q,s,t) - 0.5d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist) enddo ! i do i = elec_beta_num+1, elec_alpha_num @@ -315,7 +315,7 @@ BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] call give_integrals_3_body_bi_ort(i, p, q, t, s, i, I_ipq_tsi) call give_integrals_3_body_bi_ort(i, p, q, i, s, t, I_ipq_ist) - no_2_v0(p,q,s,t) = no_2_v0(p,q,s,t) - 0.25d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist) + noL_2e(p,q,s,t) = noL_2e(p,q,s,t) - 0.25d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist) enddo ! i enddo ! p @@ -328,7 +328,7 @@ BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)] endif call wall_time(t1) - print*, " Wall time for no_2_v0 (min) = ", (t1 - t0)/60.d0 + print*, " Wall time for noL_2e (min) = ", (t1 - t0)/60.d0 END_PROVIDER diff --git a/src/tc_bi_ortho/slater_tc_opt.irp.f b/src/tc_bi_ortho/slater_tc_opt.irp.f index 72f55aca..f12b83e3 100644 --- a/src/tc_bi_ortho/slater_tc_opt.irp.f +++ b/src/tc_bi_ortho/slater_tc_opt.irp.f @@ -34,7 +34,9 @@ end ! --- subroutine htilde_mu_mat_opt_bi_ortho_tot(key_j, key_i, Nint, htot) - implicit none + + implicit none + BEGIN_DOC ! ! where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis @@ -82,7 +84,7 @@ subroutine htilde_mu_mat_opt_bi_ortho(key_j, key_i, Nint, hmono, htwoe, hthree, hmono = 0.d0 htwoe = 0.d0 htot = 0.d0 - hthree = 0.D0 + hthree = 0.d0 call get_excitation_degree(key_i, key_j, degree, Nint) if(degree.gt.2) return diff --git a/src/tc_bi_ortho/slater_tc_opt_diag.irp.f b/src/tc_bi_ortho/slater_tc_opt_diag.irp.f index d95c87b1..367d90dd 100644 --- a/src/tc_bi_ortho/slater_tc_opt_diag.irp.f +++ b/src/tc_bi_ortho/slater_tc_opt_diag.irp.f @@ -29,6 +29,11 @@ ref_tc_energy_tot = ref_tc_energy_1e + ref_tc_energy_2e + ref_tc_energy_3e + nuclear_repulsion + if(noL_standard) then + PROVIDE noL_0e + ref_tc_energy_tot += noL_0e + endif + END_PROVIDER ! --- @@ -107,6 +112,11 @@ subroutine diag_htilde_mu_mat_fock_bi_ortho(Nint, det_in, hmono, htwoe, hthree, htot = hmono + htwoe + hthree + nuclear_repulsion + if(noL_standard) then + PROVIDE noL_0e + htot += noL_0e + endif + end ! --- diff --git a/src/tc_bi_ortho/test_tc_bi_ortho.irp.f b/src/tc_bi_ortho/test_tc_bi_ortho.irp.f index 9cbf7748..b55419a8 100644 --- a/src/tc_bi_ortho/test_tc_bi_ortho.irp.f +++ b/src/tc_bi_ortho/test_tc_bi_ortho.irp.f @@ -509,11 +509,11 @@ subroutine test_no_0() print*, ' testing no_0 ...' - PROVIDE no_0_naive - PROVIDE no_0_v0 + PROVIDE noL_0e_naive + PROVIDE noL_0e - accu = dabs(no_0_naive - no_0_v0) - norm = dabs(no_0_naive) + accu = dabs(noL_0e_naive - noL_0e) + norm = dabs(noL_0e_naive) print*, ' accu (%) = ', 100.d0*accu/norm @@ -530,8 +530,8 @@ subroutine test_no_1() print*, ' testing no_1 ...' - PROVIDE no_1_naive - PROVIDE no_1_v0 + PROVIDE noL_1e_naive + PROVIDE noL_1e thr = 1d-8 @@ -540,8 +540,8 @@ subroutine test_no_1() do i = 1, mo_num do j = 1, mo_num - new = no_1_v0 (j,i) - ref = no_1_naive(j,i) + new = noL_1e (j,i) + ref = noL_1e_naive(j,i) contrib = dabs(new - ref) if(contrib .gt. thr) then print*, ' problem on no_aaa_contraction' @@ -570,8 +570,8 @@ subroutine test_no_2() print*, ' testing no_2 ...' - PROVIDE no_2_naive - PROVIDE no_2_v0 + PROVIDE noL_2e_naive + PROVIDE noL_2e thr = 1d-8 @@ -582,8 +582,8 @@ subroutine test_no_2() do k = 1, mo_num do l = 1, mo_num - new = no_2_v0 (l,k,j,i) - ref = no_2_naive(l,k,j,i) + new = noL_2e (l,k,j,i) + ref = noL_2e_naive(l,k,j,i) contrib = dabs(new - ref) if(contrib .gt. thr) then print*, ' problem on no_aaa_contraction' diff --git a/src/tc_keywords/EZFIO.cfg b/src/tc_keywords/EZFIO.cfg index a70ccc63..fee492b4 100644 --- a/src/tc_keywords/EZFIO.cfg +++ b/src/tc_keywords/EZFIO.cfg @@ -46,6 +46,12 @@ doc: If |true|, contracted double excitation three-body terms are included interface: ezfio,provider,ocaml default: False +[noL_standard] +type: logical +doc: If |true|, standard normal-ordering for L +interface: ezfio,provider,ocaml +default: False + [core_tc_op] type: logical doc: If |true|, takes the usual Hamiltonian for core orbitals (assumed to be doubly occupied)