mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-06-23 05:32:19 +02:00
337 lines
10 KiB
Fortran
337 lines
10 KiB
Fortran
|
|
! ---
|
|
|
|
BEGIN_PROVIDER [double precision, no_0_v0]
|
|
|
|
implicit none
|
|
integer :: i, j, k
|
|
double precision :: I_ijk_ijk, I_ijk_kij, I_ijk_jik, I_ijk_jki, I_ijk_ikj, I_ijk_kji
|
|
double precision :: t0, t1
|
|
double precision, allocatable :: tmp(:)
|
|
|
|
call wall_time(t0)
|
|
print*, " Providing no_0_v0 ..."
|
|
|
|
if(elec_alpha_num .eq. elec_beta_num) then
|
|
|
|
allocate(tmp(elec_beta_num))
|
|
|
|
!$OMP PARALLEL &
|
|
!$OMP DEFAULT (NONE) &
|
|
!$OMP PRIVATE (i, j, k, &
|
|
!$OMP I_ijk_ijk, I_ijk_kij, I_ijk_jik) &
|
|
!$OMP SHARED (elec_beta_num, tmp)
|
|
|
|
!$OMP DO
|
|
do i = 1, elec_beta_num
|
|
|
|
tmp(i) = 0.d0
|
|
do j = 1, elec_beta_num
|
|
do k = 1, elec_beta_num
|
|
|
|
call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
|
|
call give_integrals_3_body_bi_ort(i, j, k, k, i, j, I_ijk_kij)
|
|
call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)
|
|
|
|
tmp(i) = tmp(i) + 4.d0 * (2.d0 * I_ijk_ijk + I_ijk_kij - 3.d0 * I_ijk_jik)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
!$OMP END DO
|
|
!$OMP END PARALLEL
|
|
|
|
no_0_v0 = -1.d0 * (-sum(tmp)) / 6.d0
|
|
|
|
deallocate(tmp)
|
|
|
|
else
|
|
|
|
allocate(tmp(elec_alpha_num))
|
|
|
|
!$OMP PARALLEL &
|
|
!$OMP DEFAULT (NONE) &
|
|
!$OMP PRIVATE (i, j, k, &
|
|
!$OMP I_ijk_ijk, I_ijk_kij, I_ijk_jik, &
|
|
!$OMP I_ijk_jki, I_ijk_ikj, I_ijk_kji) &
|
|
!$OMP SHARED (elec_beta_num, elec_alpha_num, tmp)
|
|
|
|
!$OMP DO
|
|
do i = 1, elec_beta_num
|
|
|
|
tmp(i) = 0.d0
|
|
do j = 1, elec_beta_num
|
|
do k = 1, elec_beta_num
|
|
|
|
call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
|
|
call give_integrals_3_body_bi_ort(i, j, k, k, i, j, I_ijk_kij)
|
|
call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)
|
|
|
|
tmp(i) = tmp(i) + 4.d0 * (2.d0 * I_ijk_ijk + I_ijk_kij - 3.d0 * I_ijk_jik)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
!$OMP END DO
|
|
|
|
!$OMP DO
|
|
do i = elec_beta_num+1, elec_alpha_num
|
|
|
|
tmp(i) = 0.d0
|
|
do j = elec_beta_num+1, elec_alpha_num
|
|
do k = elec_beta_num+1, elec_alpha_num
|
|
|
|
call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
|
|
call give_integrals_3_body_bi_ort(i, j, k, k, i, j, I_ijk_kij)
|
|
call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)
|
|
|
|
tmp(i) = tmp(i) + I_ijk_ijk + 2.d0 * I_ijk_kij - 3.d0 * I_ijk_jik
|
|
enddo ! k
|
|
enddo ! j
|
|
|
|
do j = 1, elec_beta_num
|
|
do k = 1, elec_beta_num
|
|
|
|
call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
|
|
call give_integrals_3_body_bi_ort(i, j, k, j, k, i, I_ijk_jki)
|
|
call give_integrals_3_body_bi_ort(i, j, k, i, k, j, I_ijk_ikj)
|
|
call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)
|
|
call give_integrals_3_body_bi_ort(i, j, k, k, j, i, I_ijk_kji)
|
|
|
|
tmp(i) = tmp(i) + 6.d0 * (2.d0 * I_ijk_ijk + I_ijk_jki - I_ijk_ikj - I_ijk_jik - I_ijk_kji)
|
|
enddo ! k
|
|
|
|
do k = elec_beta_num+1, elec_alpha_num
|
|
|
|
call give_integrals_3_body_bi_ort(i, j, k, i, j, k, I_ijk_ijk)
|
|
call give_integrals_3_body_bi_ort(i, j, k, j, k, i, I_ijk_jki)
|
|
call give_integrals_3_body_bi_ort(i, j, k, i, k, j, I_ijk_ikj)
|
|
call give_integrals_3_body_bi_ort(i, j, k, j, i, k, I_ijk_jik)
|
|
call give_integrals_3_body_bi_ort(i, j, k, k, j, i, I_ijk_kji)
|
|
|
|
tmp(i) = tmp(i) + 3.d0 * (2.d0 * I_ijk_ijk + 2.d0 * I_ijk_jki - I_ijk_ikj - I_ijk_jik - 2.d0 * I_ijk_kji)
|
|
enddo ! k
|
|
enddo ! j
|
|
enddo ! i
|
|
!$OMP END DO
|
|
!$OMP END PARALLEL
|
|
|
|
no_0_v0 = -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*, " no_0_v0 = ", no_0_v0
|
|
|
|
END_PROVIDER
|
|
|
|
! ---
|
|
|
|
BEGIN_PROVIDER [double precision, no_1_v0, (mo_num, mo_num)]
|
|
|
|
BEGIN_DOC
|
|
!
|
|
! x (-1) because integrals are over -L
|
|
!
|
|
END_DOC
|
|
|
|
implicit none
|
|
integer :: p, s, i, j
|
|
double precision :: I_pij_sij, I_pij_isj, I_pij_ijs, I_pij_sji, I_pij_jsi, I_pij_jis
|
|
double precision :: t0, t1
|
|
|
|
call wall_time(t0)
|
|
print*, " Providing no_1_v0 ..."
|
|
|
|
if(elec_alpha_num .eq. elec_beta_num) then
|
|
|
|
!$OMP PARALLEL &
|
|
!$OMP DEFAULT (NONE) &
|
|
!$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 DO COLLAPSE(2)
|
|
do s = 1, mo_num
|
|
do p = 1, mo_num
|
|
|
|
no_1_v0(p,s) = 0.d0
|
|
do i = 1, elec_beta_num
|
|
do j = 1, elec_beta_num
|
|
|
|
call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
|
|
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)
|
|
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)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
!$OMP END DO
|
|
!$OMP END PARALLEL
|
|
|
|
else
|
|
|
|
!$OMP PARALLEL &
|
|
!$OMP DEFAULT (NONE) &
|
|
!$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 DO COLLAPSE(2)
|
|
do s = 1, mo_num
|
|
do p = 1, mo_num
|
|
|
|
no_1_v0(p,s) = 0.d0
|
|
do i = 1, elec_beta_num
|
|
do j = 1, elec_beta_num
|
|
|
|
call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
|
|
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)
|
|
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)
|
|
enddo ! j
|
|
enddo ! i
|
|
|
|
do i = elec_beta_num+1, elec_alpha_num
|
|
do j = 1, elec_beta_num
|
|
|
|
call give_integrals_3_body_bi_ort(p, i, j, s, j, i, I_pij_sji)
|
|
call give_integrals_3_body_bi_ort(p, i, j, j, s, i, I_pij_jsi)
|
|
call give_integrals_3_body_bi_ort(p, i, j, j, i, s, I_pij_jis)
|
|
call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
|
|
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)
|
|
enddo ! j
|
|
|
|
do j = elec_beta_num+1, elec_alpha_num
|
|
|
|
call give_integrals_3_body_bi_ort(p, i, j, s, i, j, I_pij_sij)
|
|
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)
|
|
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)
|
|
enddo ! j
|
|
enddo ! i
|
|
|
|
enddo ! p
|
|
enddo ! s
|
|
!$OMP END DO
|
|
!$OMP END PARALLEL
|
|
|
|
endif
|
|
|
|
call wall_time(t1)
|
|
print*, " Wall time for no_1_v0 (min) = ", (t1 - t0)/60.d0
|
|
|
|
END_PROVIDER
|
|
|
|
! ---
|
|
|
|
BEGIN_PROVIDER [double precision, no_2_v0, (mo_num, mo_num, mo_num, mo_num)]
|
|
|
|
BEGIN_DOC
|
|
!
|
|
! x (-1) because integrals are over -L
|
|
!
|
|
END_DOC
|
|
|
|
implicit none
|
|
integer :: p, q, s, t, i
|
|
double precision :: I_ipq_sit, I_ipq_tsi, I_ipq_ist
|
|
double precision :: t0, t1
|
|
|
|
call wall_time(t0)
|
|
print*, " Providing no_2_v0 ..."
|
|
|
|
if(elec_alpha_num .eq. elec_beta_num) then
|
|
|
|
!$OMP PARALLEL &
|
|
!$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 DO COLLAPSE(4)
|
|
do t = 1, mo_num
|
|
do s = 1, mo_num
|
|
do q = 1, mo_num
|
|
do p = 1, mo_num
|
|
|
|
no_2_v0(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)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
enddo
|
|
!$OMP END DO
|
|
!$OMP END PARALLEL
|
|
|
|
else
|
|
|
|
!$OMP PARALLEL &
|
|
!$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 DO COLLAPSE(4)
|
|
do t = 1, mo_num
|
|
do s = 1, mo_num
|
|
do q = 1, mo_num
|
|
do p = 1, mo_num
|
|
|
|
no_2_v0(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)
|
|
enddo ! i
|
|
|
|
do i = elec_beta_num+1, elec_alpha_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.25d0 * (I_ipq_sit + I_ipq_tsi - 2.d0*I_ipq_ist)
|
|
enddo ! i
|
|
|
|
enddo ! p
|
|
enddo ! q
|
|
enddo ! s
|
|
enddo ! t
|
|
!$OMP END DO
|
|
!$OMP END PARALLEL
|
|
|
|
endif
|
|
|
|
call wall_time(t1)
|
|
print*, " Wall time for no_2_v0 (min) = ", (t1 - t0)/60.d0
|
|
|
|
END_PROVIDER
|
|
|
|
! ---
|
|
|