LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 11:33:29 +01:00
Code Releases Activity

it works

Browse Source
This commit is contained in:
eginer 2022-11-17 18:28:48 +01:00
parent 5825152f96
commit 20676f37e8
1 changed files with 76 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
src/tc_scf/fock_three_bi_ortho_new_new.irp.f
View File

@ -47,49 +47,74 @@ 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
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
! 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)
! fock_a_tot_3e_bi_orth_new(a,i) += 0.5d0 * (contrib_sss + contrib_soo) + contrib_sos
! enddo
! enddo
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)
do j = elec_beta_num + 1, elec_alpha_num
do k = 1, elec_beta_num
call contrib_3e_sss(a,i,j,k,contrib_sss)
call contrib_3e_sos(a,i,j,k,contrib_sos)
fock_a_tot_3e_bi_orth_new(a,i) += 0.5d0 * contrib_sss + contrib_sos
enddo
enddo
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)
fock_a_tot_3e_bi_orth_new(a,i) += 0.5d0 * 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
! do j = 1, elec_beta_num
! do k = elec_beta_num+1, elec_alpha_num
! call contrib_3e_sss(a,i,j,k,contrib_sss)
! fock_a_tot_3e_bi_orth_new(a,i) += 0.5d0 * contrib_sss
! enddo
! enddo
!
! do j = elec_beta_num+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_tot_3e_bi_orth_new(a,i) += 0.5d0 * contrib_sss
! enddo
! enddo
enddo
enddo
@ -98,22 +123,36 @@ 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
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)
fock_cs_3e_bi_orth(a,i) += 0.5d0 * (contrib_sss + contrib_soo) + contrib_sos
! 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
@ -125,14 +164,6 @@ BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth_new, (mo_num, mo_num)]
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)
! fock_b_tot_3e_bi_orth_new(a,i) += 0.5d0 * (contrib_sss + contrib_soo) + contrib_sos
! enddo
! enddo
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
@ -141,12 +172,6 @@ BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth_new, (mo_num, mo_num)]
fock_b_tot_3e_bi_orth_new(a,i) += 0.5d0 * contrib_soo
enddo
enddo
! do j = elec_beta_num + 1, elec_alpha_num
! do k = 1, elec_beta_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
@ -156,13 +181,6 @@ BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth_new, (mo_num, mo_num)]
enddo
enddo
! do j = elec_beta_num+1, elec_alpha_num
! do k = elec_beta_num+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
enddo
enddo