mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-04 07:05:58 +02:00
Optimized direct 5idx
This commit is contained in:
parent
fb5300a8e5
commit
c4612318ae
@ -7,7 +7,8 @@ program bi_ort_ints
|
||||
my_n_pt_r_grid = 10
|
||||
my_n_pt_a_grid = 14
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
call test_3e
|
||||
! call test_3e
|
||||
call test_5idx
|
||||
end
|
||||
|
||||
subroutine test_3e
|
||||
@ -19,15 +20,13 @@ subroutine test_3e
|
||||
n = 0
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
new = three_e_5_idx_exch12_bi_ort(m,l,j,k,i)
|
||||
ref = three_e_5_idx_exch12_bi_ort_old(m,l,j,k,i)
|
||||
! do n = 1, mo_num
|
||||
! call give_integrals_3_body_bi_ort(n, l, k, m, j, i, new)
|
||||
! call give_integrals_3_body_bi_ort_old(n, l, k, m, j, i, ref)
|
||||
do n = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(n, l, k, m, j, i, new)
|
||||
call give_integrals_3_body_bi_ort_old(n, l, k, m, j, i, ref)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. 1.d-10)then
|
||||
@ -36,7 +35,7 @@ subroutine test_3e
|
||||
print*,ref,new,contrib
|
||||
stop
|
||||
endif
|
||||
! enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
@ -46,3 +45,48 @@ subroutine test_3e
|
||||
|
||||
|
||||
end
|
||||
|
||||
subroutine test_5idx
|
||||
implicit none
|
||||
integer :: i,k,j,l,m,n,ipoint
|
||||
double precision :: accu, contrib,new,ref
|
||||
i = 1
|
||||
k = 1
|
||||
n = 0
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
new = three_e_5_idx_direct_bi_ort(m,l,j,k,i)
|
||||
ref = three_e_5_idx_direct_bi_ort_old(m,l,j,k,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. 1.d-10)then
|
||||
print*,'direct'
|
||||
print*,i,k,j,l,m
|
||||
print*,ref,new,contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
! new = three_e_5_idx_exch12_bi_ort(m,l,j,k,i)
|
||||
! ref = three_e_5_idx_exch12_bi_ort_old(m,l,j,k,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. 1.d-10)then
|
||||
! print*,'exch12'
|
||||
! print*,i,k,j,l,m
|
||||
! print*,ref,new,contrib
|
||||
! stop
|
||||
! endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*,'accu = ',accu/dble(mo_num)**5
|
||||
|
||||
|
||||
end
|
||||
|
@ -1,7 +1,8 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
@ -12,257 +13,6 @@ BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort, (mo_num, mo_num,
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_direct_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_direct_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_direct_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, m, j, i, integral)
|
||||
three_e_5_idx_direct_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_direct_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = <mlk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_cycle_1_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_cycle_1_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_1_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, i, m, integral)
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_1_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = <mlk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_cycle_2_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_cycle_2_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_2_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, m, j, integral)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_2_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_exch23_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch23_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch23_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, m, i, integral)
|
||||
three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch23_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = <mlk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_5_idx_exch13_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_5_idx_exch13_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch13_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, j, m, integral)
|
||||
three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch13_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = <mlk|-L|mij> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
! Equivalent to:
|
||||
!
|
||||
! call give_integrals_3_body_bi_ort(m, l, k, m, i, j, integral)
|
||||
!
|
||||
! three_e_5_idx_exch12_bi_ort_old(m,l,j,k,i) = -1.d0 * integral
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: wall1, wall0
|
||||
@ -279,7 +29,7 @@ BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num,
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
PROVIDE mo_l_coef mo_r_coef int2_grad1_u12_bimo_t
|
||||
|
||||
print *, ' Providing the three_e_5_idx_exch12_bi_ort ...'
|
||||
print *, ' Providing the three_e_5_idx_direct_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
do m = 1, mo_num
|
||||
@ -322,6 +72,7 @@ BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num,
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
three_e_5_idx_direct_bi_ort(m,l,j,k,i) = - tmp_mat(l,j,k,i) - tmp_mat(k,i,l,j)
|
||||
three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = - tmp_mat(l,i,k,j) - tmp_mat(k,j,l,i)
|
||||
enddo
|
||||
enddo
|
||||
@ -339,8 +90,8 @@ BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num,
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = &
|
||||
three_e_5_idx_exch12_bi_ort(m,l,j,k,i) - tmp_mat(l,i,k,j)
|
||||
three_e_5_idx_direct_bi_ort(m,l,j,k,i) = three_e_5_idx_direct_bi_ort(m,l,j,k,i) - tmp_mat(l,j,k,i)
|
||||
three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = three_e_5_idx_exch12_bi_ort(m,l,j,k,i) - tmp_mat(l,i,k,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
@ -350,9 +101,246 @@ BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num,
|
||||
enddo
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch12_bi_ort', wall1 - wall0
|
||||
print *, ' wall time for three_e_5_idx_direct_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = <mlk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
double precision :: integral
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: wall1, wall0
|
||||
integer :: ipoint
|
||||
double precision :: weight
|
||||
double precision, allocatable :: grad_mli(:,:,:), m2grad_r(:,:,:,:), m2grad_l(:,:,:,:)
|
||||
double precision, allocatable :: tmp_mat(:,:,:,:), orb_mat(:,:,:)
|
||||
allocate(m2grad_r(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(m2grad_l(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp_mat(mo_num,mo_num,mo_num,mo_num))
|
||||
allocate(grad_mli(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(orb_mat(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
PROVIDE mo_l_coef mo_r_coef int2_grad1_u12_bimo_t
|
||||
|
||||
print *, ' Providing the three_e_5_idx_cycle_1_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_1_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, i, m, integral)
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_1_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = <mlk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
double precision :: integral
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: wall1, wall0
|
||||
integer :: ipoint
|
||||
double precision :: weight
|
||||
double precision, allocatable :: grad_mli(:,:,:), m2grad_r(:,:,:,:), m2grad_l(:,:,:,:)
|
||||
double precision, allocatable :: tmp_mat(:,:,:,:), orb_mat(:,:,:)
|
||||
allocate(m2grad_r(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(m2grad_l(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp_mat(mo_num,mo_num,mo_num,mo_num))
|
||||
allocate(grad_mli(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(orb_mat(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
PROVIDE mo_l_coef mo_r_coef int2_grad1_u12_bimo_t
|
||||
|
||||
print *, ' Providing the three_e_5_idx_cycle_2_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_cycle_2_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, m, j, integral)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_cycle_2_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
double precision :: integral
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: wall1, wall0
|
||||
integer :: ipoint
|
||||
double precision :: weight
|
||||
double precision, allocatable :: grad_mli(:,:,:), m2grad_r(:,:,:,:), m2grad_l(:,:,:,:)
|
||||
double precision, allocatable :: tmp_mat(:,:,:,:), orb_mat(:,:,:)
|
||||
allocate(m2grad_r(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(m2grad_l(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp_mat(mo_num,mo_num,mo_num,mo_num))
|
||||
allocate(grad_mli(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(orb_mat(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
PROVIDE mo_l_coef mo_r_coef int2_grad1_u12_bimo_t
|
||||
|
||||
print *, ' Providing the three_e_5_idx_exch23_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch23_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, j, m, i, integral)
|
||||
three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch23_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_5_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = <mlk|-L|ijm> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
double precision :: integral
|
||||
integer :: i, j, k, m, l
|
||||
double precision :: wall1, wall0
|
||||
integer :: ipoint
|
||||
double precision :: weight
|
||||
double precision, allocatable :: grad_mli(:,:,:), m2grad_r(:,:,:,:), m2grad_l(:,:,:,:)
|
||||
double precision, allocatable :: tmp_mat(:,:,:,:), orb_mat(:,:,:)
|
||||
allocate(m2grad_r(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(m2grad_l(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp_mat(mo_num,mo_num,mo_num,mo_num))
|
||||
allocate(grad_mli(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(orb_mat(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
PROVIDE mo_l_coef mo_r_coef int2_grad1_u12_bimo_t
|
||||
|
||||
print *, ' Providing the three_e_5_idx_exch13_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,k,m,l,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_5_idx_exch13_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, l, k, i, j, m, integral)
|
||||
three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_exch13_bi_ort', wall1 - wall0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user