mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-24 21:21:47 +02:00
noL dredding
This commit is contained in:
parent
e288c40d8b
commit
19b9976d13
@ -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
|
||||
|
||||
! ---
|
||||
|
@ -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
|
||||
|
||||
! ---
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
!
|
||||
! <key_j |H_tilde | key_i> 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
|
||||
|
@ -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
|
||||
|
||||
! ---
|
||||
|
@ -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'
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user