From c91b0b21fb8b104e9ef699c2cfc12e9706f87e5a Mon Sep 17 00:00:00 2001 From: eginer Date: Thu, 17 Nov 2022 19:14:25 +0100 Subject: [PATCH] fock_three_bi_ortho_new_new.irp.f is ok --- src/tc_scf/fock_three_bi_ortho_new_new.irp.f | 296 ++++++++++--------- 1 file changed, 154 insertions(+), 142 deletions(-) diff --git a/src/tc_scf/fock_three_bi_ortho_new_new.irp.f b/src/tc_scf/fock_three_bi_ortho_new_new.irp.f index 63c4cd93..b3ef38c0 100644 --- a/src/tc_scf/fock_three_bi_ortho_new_new.irp.f +++ b/src/tc_scf/fock_three_bi_ortho_new_new.irp.f @@ -1,3 +1,157 @@ +BEGIN_PROVIDER [double precision, fock_a_tmp2_bi_ortho, (mo_num, mo_num)] + implicit none + integer :: i,a,j,k + double precision :: contrib_sss + fock_a_tmp2_bi_ortho = 0.d0 + do i = 1, mo_num + do a = 1, mo_num + do j = 1, elec_alpha_num + do k = elec_beta_num+1, elec_alpha_num + call contrib_3e_sss(a,i,j,k,contrib_sss) + fock_a_tmp2_bi_ortho(a,i) += 0.5d0 * contrib_sss + enddo + enddo + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth_new, (mo_num, mo_num)] + implicit none + integer :: i,a,j,k + double precision :: contrib_sss, contrib_sos, contrib_soo,contrib + fock_b_tot_3e_bi_orth_new = 0.d0 + do i = 1, mo_num + do a = 1, mo_num + fock_b_tot_3e_bi_orth_new(a,i) += fock_cs_3e_bi_orth(a,i) + fock_b_tot_3e_bi_orth_new(a,i) += fock_b_tmp2_bi_ortho(a,i) + fock_b_tot_3e_bi_orth_new(a,i) += fock_b_tmp1_bi_ortho(a,i) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [double precision, fock_cs_3e_bi_orth, (mo_num, mo_num)] + implicit none + integer :: i,a,j,k + double precision :: contrib_sss, contrib_sos, contrib_soo, contrib + double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int + double precision :: new + fock_cs_3e_bi_orth = 0.d0 + do i = 1, mo_num + do a = 1, mo_num + + do j = 1, elec_beta_num + do k = 1, elec_beta_num +! call contrib_3e_sss(a,i,j,k,contrib_sss) +! call contrib_3e_soo(a,i,j,k,contrib_soo) +! call contrib_3e_sos(a,i,j,k,contrib_sos) +! contrib = 0.5d0 * (contrib_sss + contrib_soo) + contrib_sos + + call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j > + call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k > + call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i > + ! negative terms :: exchange contrib + call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13 + call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23 + call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12 + new = 2.d0 * direct_int + 0.5d0 * (c_3_int + c_minus_3_int - exch_12_int) & + -1.5d0 * exch_13_int - exch_23_int + fock_cs_3e_bi_orth(a,i) += new + enddo + enddo + + enddo + enddo + fock_cs_3e_bi_orth = - fock_cs_3e_bi_orth + +END_PROVIDER + + + +BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth_new, (mo_num, mo_num)] + implicit none + integer :: i,a,j,k + double precision :: contrib_sss, contrib_sos, contrib_soo,contrib + fock_a_tot_3e_bi_orth_new = 0.d0 + do i = 1, mo_num + do a = 1, mo_num + fock_a_tot_3e_bi_orth_new(a,i) += fock_cs_3e_bi_orth(a,i) + fock_a_tot_3e_bi_orth_new(a,i) += fock_a_tmp1_bi_ortho(a,i) + fock_a_tot_3e_bi_orth_new(a,i) += fock_a_tmp2_bi_ortho(a,i) + enddo + enddo +END_PROVIDER + +BEGIN_PROVIDER [double precision, fock_a_tmp1_bi_ortho, (mo_num, mo_num)] + implicit none + integer :: i,a,j,k + double precision :: contrib_sss, contrib_sos, contrib_soo, contrib + double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int + double precision :: new + fock_a_tmp1_bi_ortho = 0.d0 + do i = 1, mo_num + do a = 1, mo_num + + do j = elec_beta_num + 1, elec_alpha_num + do k = 1, elec_beta_num + call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j > + call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k > + call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i > + call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13 + call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23 + call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12 + fock_a_tmp1_bi_ortho(a,i) += 1.5d0 * (direct_int - exch_13_int) & + + 0.5d0 * (c_3_int + c_minus_3_int - exch_23_int - exch_12_int) + enddo + enddo + + enddo + enddo + fock_a_tmp1_bi_ortho = - fock_a_tmp1_bi_ortho +END_PROVIDER + + + + +BEGIN_PROVIDER [double precision, fock_b_tmp1_bi_ortho, (mo_num, mo_num)] + implicit none + integer :: i,a,j,k + double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int + double precision :: new + fock_b_tmp1_bi_ortho = 0.d0 + do i = 1, mo_num + do a = 1, mo_num + + do j = 1, elec_beta_num + do k = elec_beta_num+1, elec_alpha_num + call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j > + call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13 + call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23 + fock_b_tmp1_bi_ortho(a,i) += 1.5d0 * direct_int - 0.5d0 * exch_23_int - exch_13_int + enddo + enddo + + enddo + enddo + fock_b_tmp1_bi_ortho = - fock_b_tmp1_bi_ortho +END_PROVIDER + +BEGIN_PROVIDER [double precision, fock_b_tmp2_bi_ortho, (mo_num, mo_num)] + implicit none + integer :: i,a,j,k + double precision :: contrib_soo + fock_b_tmp2_bi_ortho = 0.d0 + do i = 1, mo_num + do a = 1, mo_num + do j = elec_beta_num + 1, elec_alpha_num + do k = 1, elec_alpha_num + call contrib_3e_soo(a,i,j,k,contrib_soo) + fock_b_tmp2_bi_ortho(a,i) += 0.5d0 * contrib_soo + enddo + enddo + enddo + enddo +END_PROVIDER + subroutine contrib_3e_sss(a,i,j,k,integral) integer, intent(in) :: a,i,j,k BEGIN_DOC @@ -43,145 +197,3 @@ subroutine contrib_3e_sos(a,i,j,k,integral) integral = direct_int - exch_13_int integral = -integral end - -BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth_new, (mo_num, mo_num)] - implicit none - integer :: i,a,j,k - double precision :: contrib_sss, contrib_sos, contrib_soo,contrib - fock_a_tot_3e_bi_orth_new = 0.d0 - do i = 1, mo_num - do a = 1, mo_num - - fock_a_tot_3e_bi_orth_new(a,i) += fock_cs_3e_bi_orth(a,i) - fock_a_tot_3e_bi_orth_new(a,i) += fock_a_tmp1_bi_ortho(a,i) - - contrib = 0.d0 - do j = 1, elec_alpha_num - do k = elec_beta_num+1, elec_alpha_num - call contrib_3e_sss(a,i,j,k,contrib_sss) - contrib += 0.5d0 * contrib_sss - enddo - enddo - if(dabs(contrib-fock_a_tmp2_bi_ortho(a,i)).gt.1.d-10)then - print*,'pb !!' - print*,contrib,fock_a_tmp2_bi_ortho(a,i) - stop - endif - fock_a_tot_3e_bi_orth_new(a,i) += contrib - - enddo - enddo -END_PROVIDER - -BEGIN_PROVIDER [double precision, fock_a_tmp1_bi_ortho, (mo_num, mo_num)] - implicit none - integer :: i,a,j,k - double precision :: contrib_sss, contrib_sos, contrib_soo, contrib - double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int - double precision :: new - fock_a_tmp1_bi_ortho = 0.d0 - do i = 1, mo_num - do a = 1, mo_num - - do j = elec_beta_num + 1, elec_alpha_num - do k = 1, elec_beta_num - call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j > - call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k > - call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i > - call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13 - call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23 - call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12 - fock_a_tmp1_bi_ortho(a,i) += 1.5d0 * (direct_int - exch_13_int) & - + 0.5d0 * (c_3_int + c_minus_3_int - exch_23_int - exch_12_int) - enddo - enddo - - enddo - enddo - fock_a_tmp1_bi_ortho = - fock_a_tmp1_bi_ortho -END_PROVIDER - -BEGIN_PROVIDER [double precision, fock_a_tmp2_bi_ortho, (mo_num, mo_num)] - implicit none - integer :: i,a,j,k - double precision :: contrib_sss - fock_a_tmp2_bi_ortho = 0.d0 - do i = 1, mo_num - do a = 1, mo_num - - do j = 1, elec_alpha_num - do k = elec_beta_num+1, elec_alpha_num - call contrib_3e_sss(a,i,j,k,contrib_sss) - fock_a_tmp2_bi_ortho(a,i) += 0.5d0 * contrib_sss - enddo - enddo - - enddo - enddo -END_PROVIDER - -BEGIN_PROVIDER [double precision, fock_cs_3e_bi_orth, (mo_num, mo_num)] - implicit none - integer :: i,a,j,k - double precision :: contrib_sss, contrib_sos, contrib_soo, contrib - double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int - double precision :: new - fock_cs_3e_bi_orth = 0.d0 - do i = 1, mo_num - do a = 1, mo_num - - do j = 1, elec_beta_num - do k = 1, elec_beta_num -! call contrib_3e_sss(a,i,j,k,contrib_sss) -! call contrib_3e_soo(a,i,j,k,contrib_soo) -! call contrib_3e_sos(a,i,j,k,contrib_sos) -! contrib = 0.5d0 * (contrib_sss + contrib_soo) + contrib_sos - - call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j > - call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k > - call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i > - ! negative terms :: exchange contrib - call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13 - call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23 - call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12 - new = 2.d0 * direct_int + 0.5d0 * (c_3_int + c_minus_3_int - exch_12_int) & - -1.5d0 * exch_13_int - exch_23_int - fock_cs_3e_bi_orth(a,i) += new - enddo - enddo - - enddo - enddo - fock_cs_3e_bi_orth = - fock_cs_3e_bi_orth - -END_PROVIDER - -BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth_new, (mo_num, mo_num)] - implicit none - integer :: i,a,j,k - double precision :: contrib_sss, contrib_sos, contrib_soo - fock_b_tot_3e_bi_orth_new = 0.d0 - do i = 1, mo_num - do a = 1, mo_num - - fock_b_tot_3e_bi_orth_new(a,i) += fock_cs_3e_bi_orth(a,i) - - do j = elec_beta_num + 1, elec_alpha_num - do k = 1, elec_alpha_num - call contrib_3e_soo(a,i,j,k,contrib_soo) - fock_b_tot_3e_bi_orth_new(a,i) += 0.5d0 * contrib_soo - enddo - enddo - - do j = 1, elec_beta_num - do k = elec_beta_num+1, elec_alpha_num - call contrib_3e_soo(a,i,j,k,contrib_soo) - call contrib_3e_sos(a,i,j,k,contrib_sos) - fock_b_tot_3e_bi_orth_new(a,i) += 0.5d0 * contrib_soo + contrib_sos - enddo - enddo - - enddo - enddo - -END_PROVIDER