9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-09 06:53:38 +01:00

implemented the new version of TC 3e fock operator
Some checks failed
continuous-integration/drone/push Build is failing

This commit is contained in:
eginer 2022-11-18 18:01:15 +01:00
parent 8bafde48ed
commit 23c0ccdd67
3 changed files with 170 additions and 330 deletions

View File

@ -1,160 +1,178 @@
! ---
BEGIN_PROVIDER [ double precision, fock_3_mat_a_op_sh_bi_orth_old, (mo_num, mo_num)]
BEGIN_DOC
! Fock matrix for opposite spin contribution for bi ortho
END_DOC
BEGIN_PROVIDER [ double precision, fock_a_abb_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
integer :: j, m, i, a
double precision :: direct_int, exch_int
fock_3_mat_a_op_sh_bi_orth_old = 0.d0
do i = 1, mo_num ! alpha single excitation
do a = 1, mo_num ! alpha single excitation
! ---
do j = 1, elec_beta_num
do m = 1, elec_beta_num
call give_integrals_3_body_bi_ort(a, m, j, i, m, j, direct_int)
fock_3_mat_a_op_sh_bi_orth_old(a,i) += 1.d0 * direct_int
call give_integrals_3_body_bi_ort(a, m, j, j, m, i, exch_int)
fock_3_mat_a_op_sh_bi_orth_old(a,i) += -1.d0 * exch_int
enddo
enddo
! ---
do j = 1, elec_beta_num ! beta
do m = j+1, elec_beta_num ! beta
call give_integrals_3_body_bi_ort(a, m, j, i, m, j, direct_int)
fock_3_mat_a_op_sh_bi_orth_old(a,i) += 1.d0 * direct_int
call give_integrals_3_body_bi_ort(a, m, j, i, j, m, exch_int)
fock_3_mat_a_op_sh_bi_orth_old(a,i) += -1.d0 * exch_int
enddo
enddo
! ---
enddo
enddo
fock_3_mat_a_op_sh_bi_orth_old = - fock_3_mat_a_op_sh_bi_orth_old
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, fock_3_mat_a_op_sh_bi_orth, (mo_num, mo_num)]
BEGIN_DOC
! Fock matrix for opposite spin contribution for bi ortho
! fock_a_abb_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,beta,beta contribution
END_DOC
implicit none
integer :: i, a
double precision :: integral1, integral2, integral3
fock_3_mat_a_op_sh_bi_orth = 0.d0
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i, a, integral1, integral2, integral3) &
!$OMP SHARED (mo_num, fock_3_mat_a_op_sh_bi_orth)
!$OMP DO SCHEDULE (dynamic)
do i = 1, mo_num ! alpha single excitation
do a = 1, mo_num ! alpha single excitation
call direct_term_imj_bi_ortho(a, i, integral1)
call exch_term_jmi_bi_ortho (a, i, integral2)
call exch_term_ijm_bi_ortho (a, i, integral3)
fock_3_mat_a_op_sh_bi_orth(a,i) += 1.5d0 * integral1 - integral2 - 0.5d0 * integral3
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
fock_3_mat_a_op_sh_bi_orth = - fock_3_mat_a_op_sh_bi_orth
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, fock_3_mat_a_sa_sh_bi_orth_old, (mo_num, mo_num)]
BEGIN_DOC
! Fock matrix for same spin contribution for bi ortho
END_DOC
implicit none
integer :: j, m, i, a
double precision :: direct_int, cyclic_1, cyclic_2, non_cyclic_1, non_cyclic_2, non_cyclic_3
fock_3_mat_a_sa_sh_bi_orth_old = 0.d0
fock_a_abb_3e_bi_orth_old = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_23_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_beta_num
do m = j+1, elec_beta_num
call give_integrals_3_body_bi_ort(a, m, j, i, m, j, direct_int)
call give_integrals_3_body_bi_ort(a, m, j, j, i, m, cyclic_1)
call give_integrals_3_body_bi_ort(a, m, j, m, j, i, cyclic_2)
fock_3_mat_a_sa_sh_bi_orth_old(a,i) += direct_int + cyclic_1 + cyclic_2
call give_integrals_3_body_bi_ort(a, m, j, j, m, i, non_cyclic_1)
call give_integrals_3_body_bi_ort(a, m, j, i, j, m, non_cyclic_2)
call give_integrals_3_body_bi_ort(a, m, j, m, i, j, non_cyclic_3)
fock_3_mat_a_sa_sh_bi_orth_old(a,i) += -1.d0 * (non_cyclic_1 + non_cyclic_2 + non_cyclic_3)
enddo
enddo
do k = j+1, elec_beta_num
! see contrib_3e_soo
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, i, j, k, exch_23_int)! < a k j | i j k > : E_23
fock_a_abb_3e_bi_orth_old(a,i) += direct_int - exch_23_int
enddo
enddo
fock_3_mat_a_sa_sh_bi_orth_old = -fock_3_mat_a_sa_sh_bi_orth_old
enddo
enddo
fock_a_abb_3e_bi_orth_old = - fock_a_abb_3e_bi_orth_old
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, fock_3_mat_a_sa_sh_bi_orth, (mo_num, mo_num)]
BEGIN_DOC
! Fock matrix for same spin contribution for bi ortho
END_DOC
BEGIN_PROVIDER [ double precision, fock_a_aba_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
integer :: j, m, i, a
double precision :: integral1, integral2, integral3, integral4
fock_3_mat_a_sa_sh_bi_orth = 0.d0
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (i, a, integral1, integral2, integral3, integral4) &
!$OMP SHARED (mo_num, fock_3_mat_a_sa_sh_bi_orth)
!$OMP DO SCHEDULE (dynamic)
BEGIN_DOC
! fock_a_aba_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,beta contribution
END_DOC
fock_a_aba_3e_bi_orth_old = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int
do i = 1, mo_num
do a = 1, mo_num
call direct_term_imj_bi_ortho(a, i, integral1)
call cyclic_term_jim_bi_ortho(a, i, integral2)
call exch_term_jmi_bi_ortho (a, i, integral3)
call exch_term_ijm_bi_ortho (a, i, integral4)
fock_3_mat_a_sa_sh_bi_orth(a,i) += 0.5d0 * (integral1 - integral4) + integral2 - integral3
enddo
enddo
!$OMP END DO
!$OMP END PARALLEL
fock_3_mat_a_sa_sh_bi_orth = -fock_3_mat_a_sa_sh_bi_orth
do j = 1, elec_alpha_num ! a
do k = 1, elec_beta_num ! b
! a b a a b a
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
fock_a_aba_3e_bi_orth_old(a,i) += direct_int - exch_13_int
enddo
enddo
enddo
enddo
fock_a_aba_3e_bi_orth_old = - fock_a_aba_3e_bi_orth_old
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_a_aaa_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_a_aaa_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,alpha contribution
END_DOC
fock_a_aaa_3e_bi_orth_old = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_alpha_num
do k = j+1, elec_alpha_num
! positive terms :: cycle contrib
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 >
fock_a_aaa_3e_bi_orth_old(a,i) += direct_int + c_3_int + c_minus_3_int
! 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
fock_a_aaa_3e_bi_orth_old(a,i) += - exch_13_int - exch_23_int - exch_12_int
enddo
enddo
enddo
enddo
fock_a_aaa_3e_bi_orth_old = - fock_a_aaa_3e_bi_orth_old
END_PROVIDER
BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_a_tot_3e_bi_orth_old = bi-ortho 3-e Fock matrix for alpha electrons from all possible spin contributions
END_DOC
fock_a_tot_3e_bi_orth_old = fock_a_abb_3e_bi_orth_old + fock_a_aba_3e_bi_orth_old + fock_a_aaa_3e_bi_orth_old
END_PROVIDER
! ---
BEGIN_PROVIDER [ double precision, fock_b_baa_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_baa_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for beta electrons from beta,alpha,alpha contribution
END_DOC
fock_b_baa_3e_bi_orth_old = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_23_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_alpha_num
do k = j+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, i, j, k, exch_23_int)! < a k j | i j k > : E_23
fock_b_baa_3e_bi_orth_old(a,i) += direct_int - exch_23_int
enddo
enddo
enddo
enddo
fock_b_baa_3e_bi_orth_old = - fock_b_baa_3e_bi_orth_old
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_b_bab_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_bab_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for beta electrons from beta,alpha,beta contribution
END_DOC
fock_b_bab_3e_bi_orth_old = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_beta_num
do k = 1, elec_alpha_num
! b a b b a b
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
fock_b_bab_3e_bi_orth_old(a,i) += direct_int - exch_13_int
enddo
enddo
enddo
enddo
fock_b_bab_3e_bi_orth_old = - fock_b_bab_3e_bi_orth_old
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_b_bbb_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_bbb_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,alpha contribution
END_DOC
fock_b_bbb_3e_bi_orth_old = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_beta_num
do k = j+1, elec_beta_num
! positive terms :: cycle contrib
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 >
fock_b_bbb_3e_bi_orth_old(a,i) += direct_int + c_3_int + c_minus_3_int
! 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
fock_b_bbb_3e_bi_orth_old(a,i) += - exch_13_int - exch_23_int - exch_12_int
enddo
enddo
enddo
enddo
fock_b_bbb_3e_bi_orth_old = - fock_b_bbb_3e_bi_orth_old
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_b_tot_3e_bi_orth_old, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_tot_3e_bi_orth_old = bi-ortho 3-e Fock matrix for alpha electrons from all possible spin contributions
END_DOC
fock_b_tot_3e_bi_orth_old = fock_b_bbb_3e_bi_orth_old + fock_b_bab_3e_bi_orth_old + fock_b_baa_3e_bi_orth_old
END_PROVIDER

View File

@ -1,178 +0,0 @@
BEGIN_PROVIDER [ double precision, fock_a_abb_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_a_abb_3e_bi_orth(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,beta,beta contribution
END_DOC
fock_a_abb_3e_bi_orth = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_23_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_beta_num
do k = j+1, elec_beta_num
! see contrib_3e_soo
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, i, j, k, exch_23_int)! < a k j | i j k > : E_23
fock_a_abb_3e_bi_orth(a,i) += direct_int - exch_23_int
enddo
enddo
enddo
enddo
fock_a_abb_3e_bi_orth = - fock_a_abb_3e_bi_orth
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_a_aba_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_a_aba_3e_bi_orth(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,beta contribution
END_DOC
fock_a_aba_3e_bi_orth = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_alpha_num ! a
do k = 1, elec_beta_num ! b
! a b a a b a
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
fock_a_aba_3e_bi_orth(a,i) += direct_int - exch_13_int
enddo
enddo
enddo
enddo
fock_a_aba_3e_bi_orth = - fock_a_aba_3e_bi_orth
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_a_aaa_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_a_aaa_3e_bi_orth(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,alpha contribution
END_DOC
fock_a_aaa_3e_bi_orth = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_alpha_num
do k = j+1, elec_alpha_num
! positive terms :: cycle contrib
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 >
fock_a_aaa_3e_bi_orth(a,i) += direct_int + c_3_int + c_minus_3_int
! 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
fock_a_aaa_3e_bi_orth(a,i) += - exch_13_int - exch_23_int - exch_12_int
enddo
enddo
enddo
enddo
fock_a_aaa_3e_bi_orth = - fock_a_aaa_3e_bi_orth
END_PROVIDER
BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_a_tot_3e_bi_orth = bi-ortho 3-e Fock matrix for alpha electrons from all possible spin contributions
END_DOC
fock_a_tot_3e_bi_orth = fock_a_abb_3e_bi_orth + fock_a_aba_3e_bi_orth + fock_a_aaa_3e_bi_orth
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_b_baa_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_baa_3e_bi_orth(a,i) = bi-ortho 3-e Fock matrix for beta electrons from beta,alpha,alpha contribution
END_DOC
fock_b_baa_3e_bi_orth = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_23_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_alpha_num
do k = j+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, i, j, k, exch_23_int)! < a k j | i j k > : E_23
fock_b_baa_3e_bi_orth(a,i) += direct_int - exch_23_int
enddo
enddo
enddo
enddo
fock_b_baa_3e_bi_orth = - fock_b_baa_3e_bi_orth
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_b_bab_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_bab_3e_bi_orth(a,i) = bi-ortho 3-e Fock matrix for beta electrons from beta,alpha,beta contribution
END_DOC
fock_b_bab_3e_bi_orth = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_beta_num
do k = 1, elec_alpha_num
! b a b b a b
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
fock_b_bab_3e_bi_orth(a,i) += direct_int - exch_13_int
enddo
enddo
enddo
enddo
fock_b_bab_3e_bi_orth = - fock_b_bab_3e_bi_orth
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_b_bbb_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_bbb_3e_bi_orth(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,alpha contribution
END_DOC
fock_b_bbb_3e_bi_orth = 0.d0
integer :: i,a,j,k
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
do i = 1, mo_num
do a = 1, mo_num
do j = 1, elec_beta_num
do k = j+1, elec_beta_num
! positive terms :: cycle contrib
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 >
fock_b_bbb_3e_bi_orth(a,i) += direct_int + c_3_int + c_minus_3_int
! 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
fock_b_bbb_3e_bi_orth(a,i) += - exch_13_int - exch_23_int - exch_12_int
enddo
enddo
enddo
enddo
fock_b_bbb_3e_bi_orth = - fock_b_bbb_3e_bi_orth
END_PROVIDER
BEGIN_PROVIDER [ double precision, fock_b_tot_3e_bi_orth, (mo_num, mo_num)]
implicit none
BEGIN_DOC
! fock_b_tot_3e_bi_orth = bi-ortho 3-e Fock matrix for alpha electrons from all possible spin contributions
END_DOC
fock_b_tot_3e_bi_orth = fock_b_bbb_3e_bi_orth + fock_b_bab_3e_bi_orth + fock_b_baa_3e_bi_orth
END_PROVIDER

View File

@ -1,28 +1,28 @@
BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth_new, (mo_num, mo_num)]
BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth, (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
fock_a_tot_3e_bi_orth = 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)
fock_a_tot_3e_bi_orth(a,i) += fock_cs_3e_bi_orth(a,i)
fock_a_tot_3e_bi_orth(a,i) += fock_a_tmp1_bi_ortho(a,i)
fock_a_tot_3e_bi_orth(a,i) += fock_a_tmp2_bi_ortho(a,i)
enddo
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth_new, (mo_num, mo_num)]
BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth, (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
fock_b_tot_3e_bi_orth = 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)
fock_b_tot_3e_bi_orth(a,i) += fock_cs_3e_bi_orth(a,i)
fock_b_tot_3e_bi_orth(a,i) += fock_b_tmp2_bi_ortho(a,i)
fock_b_tot_3e_bi_orth(a,i) += fock_b_tmp1_bi_ortho(a,i)
enddo
enddo
END_PROVIDER