mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 20:23:40 +02:00
Improve 4idx
This commit is contained in:
parent
381c98c3ca
commit
072bea8041
@ -8,8 +8,9 @@ program bi_ort_ints
|
||||
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_5idx
|
||||
! call test_5idx2
|
||||
! call test_5idx
|
||||
! call test_5idx2
|
||||
call test_4idx
|
||||
end
|
||||
|
||||
subroutine test_5idx2
|
||||
@ -145,3 +146,184 @@ subroutine test_5idx
|
||||
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine test_4idx()
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
double precision :: accu, contrib, new, ref, thr
|
||||
|
||||
thr = 1d-5
|
||||
|
||||
PROVIDE three_e_4_idx_direct_bi_ort_old
|
||||
PROVIDE three_e_4_idx_direct_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_direct_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_direct_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_direct_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_direct_bi_ort = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_exch13_bi_ort_old
|
||||
PROVIDE three_e_4_idx_exch13_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_exch13_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_exch13_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_exch13_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_exch13_bi_ort = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
! PROVIDE three_e_4_idx_exch12_bi_ort_old
|
||||
! PROVIDE three_e_4_idx_exch12_bi_ort
|
||||
!
|
||||
! accu = 0.d0
|
||||
! do i = 1, mo_num
|
||||
! do j = 1, mo_num
|
||||
! do k = 1, mo_num
|
||||
! do l = 1, mo_num
|
||||
!
|
||||
! new = three_e_4_idx_exch12_bi_ort (l,k,j,i)
|
||||
! ref = three_e_4_idx_exch12_bi_ort_old(l,k,j,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. thr) then
|
||||
! print*, ' problem in three_e_4_idx_exch12_bi_ort'
|
||||
! print*, l, k, j, i
|
||||
! print*, ref, new, contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! print*, ' accu on three_e_4_idx_exch12_bi_ort = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_cycle_1_bi_ort_old
|
||||
PROVIDE three_e_4_idx_cycle_1_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_cycle_1_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_cycle_1_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_cycle_1_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_cycle_1_bi_ort = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
! PROVIDE three_e_4_idx_cycle_2_bi_ort_old
|
||||
! PROVIDE three_e_4_idx_cycle_2_bi_ort
|
||||
!
|
||||
! accu = 0.d0
|
||||
! do i = 1, mo_num
|
||||
! do j = 1, mo_num
|
||||
! do k = 1, mo_num
|
||||
! do l = 1, mo_num
|
||||
!
|
||||
! new = three_e_4_idx_cycle_2_bi_ort (l,k,j,i)
|
||||
! ref = three_e_4_idx_cycle_2_bi_ort_old(l,k,j,i)
|
||||
! contrib = dabs(new - ref)
|
||||
! accu += contrib
|
||||
! if(contrib .gt. thr) then
|
||||
! print*, ' problem in three_e_4_idx_cycle_2_bi_ort'
|
||||
! print*, l, k, j, i
|
||||
! print*, ref, new, contrib
|
||||
! stop
|
||||
! endif
|
||||
!
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! print*, ' accu on three_e_4_idx_cycle_2_bi_ort = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort_old
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort
|
||||
|
||||
accu = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
|
||||
new = three_e_4_idx_exch23_bi_ort (l,k,j,i)
|
||||
ref = three_e_4_idx_exch23_bi_ort_old(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem in three_e_4_idx_exch23_bi_ort'
|
||||
print*, l, k, j, i
|
||||
print*, ref, new, contrib
|
||||
stop
|
||||
endif
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on three_e_4_idx_exch23_bi_ort = ', accu / dble(mo_num)**4
|
||||
|
||||
! ---
|
||||
|
||||
return
|
||||
end
|
||||
|
@ -23,11 +23,11 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num,
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_3_idx_direct_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,j,m,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_3_idx_direct_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic)
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = j, mo_num
|
||||
@ -36,8 +36,8 @@ BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num,
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
|
@ -1,287 +1,467 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort , (mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort , (mo_num, mo_num, mo_num, mo_num)]
|
||||
&BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
!&BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort , (mo_num, mo_num, mo_num, mo_num)]
|
||||
!&BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_direct_bi_ort(m,j,k,i) = <mjk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_direct_bi_ort (m,j,k,i) = < m j k | -L | m j i > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_exch13_bi_ort (m,j,k,i) = < m j k | -L | i j m > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_exch12_bi_ort (m,j,k,i) = < m j k | -L | m i j > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! = three_e_4_idx_exch13_bi_ort (j,m,k,i)
|
||||
! three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = < m j k | -L | j i m > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = < m j k | -L | i m j > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
! = three_e_4_idx_cycle_1_bi_ort(j,m,k,i)
|
||||
!
|
||||
! 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
|
||||
! notice the -1 sign: in this way three_e_4_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_direct_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_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 m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, j, i, integral)
|
||||
three_e_4_idx_direct_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_direct_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort, (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 SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = <mjk|-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
|
||||
! three_e_4_idx_direct_bi_ort (m,j,k,i) : Lk Ri Imm Ijj + Lj Rj Imm Iki + Lm Rm Ijj Iki
|
||||
! three_e_4_idx_exch13_bi_ort (m,j,k,i) : Lk Rm Imi Ijj + Lj Rj Imi Ikm + Lm Ri Ijj Ikm
|
||||
! three_e_4_idx_cycle_1_bi_ort(m,j,k,i) : Lk Rm Imj Iji + Lj Ri Imj Ikm + Lm Rj Iji Ikm
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
integer :: ipoint, i, j, k, l, m
|
||||
double precision :: wall1, wall0
|
||||
double precision, allocatable :: tmp1(:,:,:,:), tmp2(:,:,:,:), tmp3(:,:,:,:), tmp4(:,:,:,:)
|
||||
double precision, allocatable :: tmp_4d(:,:,:,:)
|
||||
double precision, allocatable :: tmp5(:,:,:)
|
||||
double precision, allocatable :: tmp7(:,:)
|
||||
double precision, allocatable :: tmp_3d(:,:,:)
|
||||
|
||||
three_e_4_idx_cycle_1_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_cycle_1_bi_ort ...'
|
||||
print *, ' Providing the three_e_4_idx_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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_cycle_1_bi_ort)
|
||||
!$OMP DO SCHEDULE (dynamic) COLLAPSE(2)
|
||||
|
||||
allocate(tmp_4d(mo_num,mo_num,mo_num,mo_num))
|
||||
|
||||
allocate(tmp1(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp2(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp3(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(tmp4(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp1, tmp2, tmp3, tmp4)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, i, m, integral)
|
||||
three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_1_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
tmp1(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,l) * mos_l_in_r_array_transp(ipoint,i) * final_weight_at_r_vector(ipoint)
|
||||
tmp1(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,l,l) * mos_l_in_r_array_transp(ipoint,i) * final_weight_at_r_vector(ipoint)
|
||||
tmp1(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,l,l) * mos_l_in_r_array_transp(ipoint,i) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
END_PROVIDER
|
||||
tmp2(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp2(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,l,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp2(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,l,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
|
||||
! --
|
||||
tmp3(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,i,l) * mos_l_in_r_array_transp(ipoint,l) * final_weight_at_r_vector(ipoint)
|
||||
tmp3(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,i,l) * mos_l_in_r_array_transp(ipoint,l) * final_weight_at_r_vector(ipoint)
|
||||
tmp3(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,i,l) * mos_l_in_r_array_transp(ipoint,l) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort, (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 SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = <mjk|-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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_cycle_2_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, m, j, integral)
|
||||
three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_2_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort(m,j,k,i) = <mjk|-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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch23_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_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 m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, m, i, integral)
|
||||
three_e_4_idx_exch23_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch23_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch13_bi_ort(m,j,k,i) = <mjk|-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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch13_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_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 m = 1, mo_num
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, j, m, integral)
|
||||
three_e_4_idx_exch13_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch13_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch12_bi_ort(m,j,k,i) = <mjk|-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
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch12_bi_ort = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch12_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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch12_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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, i, j, integral)
|
||||
three_e_4_idx_exch12_bi_ort(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
tmp4(ipoint,1,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp4(ipoint,2,l,i) = int2_grad1_u12_bimo_t(ipoint,2,l,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp4(ipoint,3,l,i) = int2_grad1_u12_bimo_t(ipoint,3,l,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1, 3*n_points_final_grid, tmp2, 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_direct_bi_ort(m,j,k,i) = -tmp_4d(m,k,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp4, 3*n_points_final_grid, tmp1, 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d, mo_num*mo_num)
|
||||
|
||||
deallocate(tmp1)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch13_bi_ort(m,j,k,i) = -tmp_4d(m,i,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp3, 3*n_points_final_grid, tmp2, 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d, mo_num*mo_num)
|
||||
|
||||
deallocate(tmp2)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch13_bi_ort(m,j,k,i) = three_e_4_idx_exch13_bi_ort(m,j,k,i) - tmp_4d(m,k,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp3, 3*n_points_final_grid, tmp4, 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d, mo_num*mo_num)
|
||||
|
||||
deallocate(tmp3)
|
||||
deallocate(tmp4)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = -tmp_4d(m,k,j,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
|
||||
allocate(tmp1(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp1)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp1(ipoint,1,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,1,l,l) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp1(ipoint,2,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,2,l,l) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
tmp1(ipoint,3,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,3,l,l) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1, 3*n_points_final_grid, int2_grad1_u12_bimo_t, 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d, mo_num*mo_num)
|
||||
|
||||
deallocate(tmp1)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_direct_bi_ort(m,j,k,i) = three_e_4_idx_direct_bi_ort(m,j,k,i) - tmp_4d(m,j,k,i) - tmp_4d(j,m,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(tmp_4d)
|
||||
|
||||
|
||||
allocate(tmp_3d(mo_num,mo_num,mo_num))
|
||||
allocate(tmp7(n_points_final_grid,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP final_weight_at_r_vector, &
|
||||
!$OMP tmp7)
|
||||
!$OMP DO
|
||||
do i = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp7(ipoint,i) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
|
||||
allocate(tmp5(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
do m = 1, mo_num
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, k, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, m, &
|
||||
!$OMP int2_grad1_u12_bimo_t, &
|
||||
!$OMP tmp5)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp5(ipoint,k,i) = int2_grad1_u12_bimo_t(ipoint,1,k,m) * int2_grad1_u12_bimo_t(ipoint,1,m,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,k,m) * int2_grad1_u12_bimo_t(ipoint,2,m,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,k,m) * int2_grad1_u12_bimo_t(ipoint,3,m,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num, mo_num*mo_num, n_points_final_grid, 1.d0 &
|
||||
, tmp7, n_points_final_grid, tmp5, n_points_final_grid &
|
||||
, 0.d0, tmp_3d, mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
three_e_4_idx_exch13_bi_ort(m,j,k,i) = three_e_4_idx_exch13_bi_ort(m,j,k,i) - tmp_3d(j,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (j, k, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, m, &
|
||||
!$OMP mos_l_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp5)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp5(ipoint,j,k) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,j) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,m,j) * int2_grad1_u12_bimo_t(ipoint,1,k,m) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,m,j) * int2_grad1_u12_bimo_t(ipoint,2,k,m) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,m,j) * int2_grad1_u12_bimo_t(ipoint,3,k,m) )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num, n_points_final_grid, 1.d0 &
|
||||
, tmp5, n_points_final_grid, mos_r_in_r_array_transp, n_points_final_grid &
|
||||
, 0.d0, tmp_3d, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = three_e_4_idx_cycle_1_bi_ort(m,j,k,i) - tmp_3d(j,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
enddo
|
||||
|
||||
deallocate(tmp7)
|
||||
deallocate(tmp_3d)
|
||||
|
||||
|
||||
|
||||
do i = 1, mo_num
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (m, j, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, i, &
|
||||
!$OMP mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp5)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp5(ipoint,m,j) = final_weight_at_r_vector(ipoint) * mos_r_in_r_array_transp(ipoint,m) &
|
||||
* ( int2_grad1_u12_bimo_t(ipoint,1,m,j) * int2_grad1_u12_bimo_t(ipoint,1,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,m,j) * int2_grad1_u12_bimo_t(ipoint,2,j,i) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,m,j) * int2_grad1_u12_bimo_t(ipoint,3,j,i) )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num, n_points_final_grid, -1.d0 &
|
||||
, tmp5, n_points_final_grid, mos_l_in_r_array_transp, n_points_final_grid &
|
||||
, 1.d0, three_e_4_idx_cycle_1_bi_ort(1,1,1,i), mo_num*mo_num)
|
||||
|
||||
enddo
|
||||
|
||||
deallocate(tmp5)
|
||||
|
||||
|
||||
! !$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
! do i = 1, mo_num
|
||||
! do k = 1, mo_num
|
||||
! do j = 1, mo_num
|
||||
! do m = 1, mo_num
|
||||
! three_e_4_idx_exch12_bi_ort (m,j,k,i) = three_e_4_idx_exch13_bi_ort (j,m,k,i)
|
||||
! three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = three_e_4_idx_cycle_1_bi_ort(j,m,k,i)
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! enddo
|
||||
! !$OMP END PARALLEL DO
|
||||
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch12_bi_ort', wall1 - wall0
|
||||
print *, ' wall time for three_e_4_idx_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort , (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort (m,j,k,i) = < m j k | -L | j m i > ::: notice that i is the RIGHT MO and k is the LEFT MO
|
||||
!
|
||||
! notice the -1 sign: in this way three_e_4_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort (m,j,k,i) : Lk Ri Imj Ijm + Lj Rm Imj Iki + Lm Rj Ijm Iki
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l, m, ipoint
|
||||
double precision :: wall1, wall0
|
||||
double precision, allocatable :: tmp1(:,:,:,:), tmp_4d(:,:,:,:)
|
||||
double precision, allocatable :: tmp5(:,:,:), tmp6(:,:,:)
|
||||
|
||||
print *, ' Providing the three_e_4_idx_exch23_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
|
||||
|
||||
allocate(tmp5(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(tmp6(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp5, tmp6)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
tmp5(ipoint,l,i) = int2_grad1_u12_bimo_t(ipoint,1,l,i) * int2_grad1_u12_bimo_t(ipoint,1,i,l) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,2,l,i) * int2_grad1_u12_bimo_t(ipoint,2,i,l) &
|
||||
+ int2_grad1_u12_bimo_t(ipoint,3,l,i) * int2_grad1_u12_bimo_t(ipoint,3,i,l)
|
||||
|
||||
tmp6(ipoint,l,i) = final_weight_at_r_vector(ipoint) * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, n_points_final_grid, -1.d0 &
|
||||
, tmp5, n_points_final_grid, tmp6, n_points_final_grid &
|
||||
, 0.d0, three_e_4_idx_exch23_bi_ort, mo_num*mo_num)
|
||||
|
||||
deallocate(tmp5)
|
||||
deallocate(tmp6)
|
||||
|
||||
|
||||
allocate(tmp_4d(mo_num,mo_num,mo_num,mo_num))
|
||||
allocate(tmp1(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i, l, ipoint) &
|
||||
!$OMP SHARED (mo_num, n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP tmp1)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
tmp1(ipoint,1,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,1,l,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp1(ipoint,2,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,2,l,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
tmp1(ipoint,3,l,i) = final_weight_at_r_vector(ipoint) * int2_grad1_u12_bimo_t(ipoint,3,l,i) * mos_l_in_r_array_transp(ipoint,i) * mos_r_in_r_array_transp(ipoint,l)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm( 'T', 'N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0 &
|
||||
, tmp1, 3*n_points_final_grid, int2_grad1_u12_bimo_t, 3*n_points_final_grid &
|
||||
, 0.d0, tmp_4d, mo_num*mo_num)
|
||||
|
||||
deallocate(tmp1)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,m)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
three_e_4_idx_exch23_bi_ort(m,j,k,i) = three_e_4_idx_exch23_bi_ort(m,j,k,i) - tmp_4d(m,j,k,i) - tmp_4d(j,m,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(tmp_4d)
|
||||
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch23_bi_ort', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
290
src/bi_ort_ints/three_body_ijmk_old.irp.f
Normal file
290
src/bi_ort_ints/three_body_ijmk_old.irp.f
Normal file
@ -0,0 +1,290 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_direct_bi_ort_old(m,j,k,i) = <mjk|-L|mji> ::: 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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_direct_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_direct_bi_ort_old ...'
|
||||
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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_direct_bi_ort_old)
|
||||
!$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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, j, i, integral)
|
||||
three_e_4_idx_direct_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_direct_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort_old, (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 SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_1_bi_ort_old(m,j,k,i) = <mjk|-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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_cycle_1_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_cycle_1_bi_ort_old ...'
|
||||
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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_cycle_1_bi_ort_old)
|
||||
!$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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, i, m, integral)
|
||||
three_e_4_idx_cycle_1_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_1_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! --
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort_old, (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 SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_cycle_2_bi_ort_old(m,j,k,i) = <mjk|-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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_cycle_2_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_cycle_2_bi_ort_old ...'
|
||||
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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_cycle_2_bi_ort_old)
|
||||
!$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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, m, j, integral)
|
||||
three_e_4_idx_cycle_2_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_cycle_2_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch23_bi_ort_old(m,j,k,i) = <mjk|-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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch23_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch23_bi_ort_old ...'
|
||||
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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch23_bi_ort_old)
|
||||
!$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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, j, m, i, integral)
|
||||
three_e_4_idx_exch23_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch23_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch13_bi_ort_old(m,j,k,i) = <mjk|-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
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch13_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch13_bi_ort_old ...'
|
||||
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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch13_bi_ort_old)
|
||||
!$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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, i, j, m, integral)
|
||||
three_e_4_idx_exch13_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch13_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort_old, (mo_num, mo_num, mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! matrix element of the -L three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
|
||||
!
|
||||
! three_e_4_idx_exch12_bi_ort_old(m,j,k,i) = <mjk|-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
|
||||
!
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, m
|
||||
double precision :: integral, wall1, wall0
|
||||
|
||||
three_e_4_idx_exch12_bi_ort_old = 0.d0
|
||||
print *, ' Providing the three_e_4_idx_exch12_bi_ort_old ...'
|
||||
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,integral) &
|
||||
!$OMP SHARED (mo_num,three_e_4_idx_exch12_bi_ort_old)
|
||||
!$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
|
||||
call give_integrals_3_body_bi_ort(m, j, k, m, i, j, integral)
|
||||
three_e_4_idx_exch12_bi_ort_old(m,j,k,i) = -1.d0 * integral
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_4_idx_exch12_bi_ort_old', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
@ -19,17 +19,17 @@ end
|
||||
!
|
||||
! 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 :: wall1, wall0
|
||||
integer :: ipoint
|
||||
integer :: i, j, k, m, l
|
||||
integer :: ipoint
|
||||
double precision :: wall1, wall0
|
||||
double precision, allocatable :: grad_mli(:,:,:), orb_mat(:,:,:)
|
||||
double precision, allocatable :: lk_grad_mi(:,:,:,:), rk_grad_im(:,:,:,:)
|
||||
double precision, allocatable :: lm_grad_ik(:,:,:,:), rm_grad_ik(:,:,:,:)
|
||||
double precision, allocatable :: tmp_mat(:,:,:,:)
|
||||
|
||||
allocate(tmp_mat(mo_num,mo_num,mo_num,mo_num))
|
||||
|
||||
provide mos_r_in_r_array_transp mos_l_in_r_array_transp
|
||||
@ -38,201 +38,196 @@ end
|
||||
print *, ' Providing the three_e_5_idx_bi_ort ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
do m = 1, mo_num
|
||||
do m = 1, mo_num
|
||||
|
||||
allocate(grad_mli(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(orb_mat(n_points_final_grid,mo_num,mo_num))
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,l,ipoint) &
|
||||
!$OMP SHARED (m,mo_num,n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP grad_mli, orb_mat)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i=1,mo_num
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
allocate(grad_mli(n_points_final_grid,mo_num,mo_num))
|
||||
allocate(orb_mat(n_points_final_grid,mo_num,mo_num))
|
||||
|
||||
grad_mli(ipoint,l,i) = final_weight_at_r_vector(ipoint) * ( &
|
||||
int2_grad1_u12_bimo_t(ipoint,1,m,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i) + &
|
||||
int2_grad1_u12_bimo_t(ipoint,2,m,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i) + &
|
||||
int2_grad1_u12_bimo_t(ipoint,3,m,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i) )
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,l,ipoint) &
|
||||
!$OMP SHARED (m,mo_num,n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP grad_mli, orb_mat)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
do ipoint = 1, n_points_final_grid
|
||||
|
||||
orb_mat(ipoint,l,i) = mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
grad_mli(ipoint,l,i) = final_weight_at_r_vector(ipoint) * ( &
|
||||
int2_grad1_u12_bimo_t(ipoint,1,m,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i) + &
|
||||
int2_grad1_u12_bimo_t(ipoint,2,m,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i) + &
|
||||
int2_grad1_u12_bimo_t(ipoint,3,m,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i) )
|
||||
|
||||
enddo
|
||||
orb_mat(ipoint,l,i) = mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,i)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, n_points_final_grid, 1.d0, &
|
||||
orb_mat, n_points_final_grid, &
|
||||
grad_mli, n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, n_points_final_grid, 1.d0, &
|
||||
orb_mat, n_points_final_grid, &
|
||||
grad_mli, n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, 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)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(orb_mat,grad_mli)
|
||||
deallocate(orb_mat,grad_mli)
|
||||
|
||||
allocate(lm_grad_ik(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(rm_grad_ik(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(rk_grad_im(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
allocate(lm_grad_ik(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(rm_grad_ik(n_points_final_grid,3,mo_num,mo_num))
|
||||
allocate(rk_grad_im(n_points_final_grid,3,mo_num,mo_num))
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,l,ipoint) &
|
||||
!$OMP SHARED (m,mo_num,n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP rm_grad_ik, lm_grad_ik, rk_grad_im, lk_grad_mi)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i=1,mo_num
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,l,ipoint) &
|
||||
!$OMP SHARED (m,mo_num,n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP rm_grad_ik, lm_grad_ik, rk_grad_im, lk_grad_mi)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i=1,mo_num
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
lm_grad_ik(ipoint,1,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i) * final_weight_at_r_vector(ipoint)
|
||||
lm_grad_ik(ipoint,2,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i) * final_weight_at_r_vector(ipoint)
|
||||
lm_grad_ik(ipoint,3,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
lm_grad_ik(ipoint,1,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i) * final_weight_at_r_vector(ipoint)
|
||||
lm_grad_ik(ipoint,2,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i) * final_weight_at_r_vector(ipoint)
|
||||
lm_grad_ik(ipoint,3,l,i) = mos_l_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i) * final_weight_at_r_vector(ipoint)
|
||||
rm_grad_ik(ipoint,1,l,i) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i)
|
||||
rm_grad_ik(ipoint,2,l,i) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i)
|
||||
rm_grad_ik(ipoint,3,l,i) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i)
|
||||
|
||||
rm_grad_ik(ipoint,1,l,i) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,1,l,i)
|
||||
rm_grad_ik(ipoint,2,l,i) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,2,l,i)
|
||||
rm_grad_ik(ipoint,3,l,i) = mos_r_in_r_array_transp(ipoint,m) * int2_grad1_u12_bimo_t(ipoint,3,l,i)
|
||||
|
||||
rk_grad_im(ipoint,1,l,i) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,1,i,m)
|
||||
rk_grad_im(ipoint,2,l,i) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,2,i,m)
|
||||
rk_grad_im(ipoint,3,l,i) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,3,i,m)
|
||||
|
||||
enddo
|
||||
rk_grad_im(ipoint,1,l,i) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,1,i,m)
|
||||
rk_grad_im(ipoint,2,l,i) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,2,i,m)
|
||||
rk_grad_im(ipoint,3,l,i) = mos_r_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,3,i,m)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lm_grad_ik, 3*n_points_final_grid, &
|
||||
rm_grad_ik, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lm_grad_ik, 3*n_points_final_grid, &
|
||||
rm_grad_ik, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, 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) = three_e_5_idx_direct_bi_ort(m,l,j,k,i) - tmp_mat(l,j,k,i)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lm_grad_ik, 3*n_points_final_grid, &
|
||||
rk_grad_im, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lm_grad_ik, 3*n_points_final_grid, &
|
||||
rk_grad_im, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = - tmp_mat(l,i,j,k)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = - tmp_mat(k,j,i,l)
|
||||
three_e_5_idx_exch23_bi_ort (m,l,j,k,i) = - tmp_mat(k,i,j,l)
|
||||
three_e_5_idx_exch13_bi_ort (m,l,j,k,i) = - tmp_mat(l,j,i,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
deallocate(lm_grad_ik)
|
||||
|
||||
allocate(lk_grad_mi(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,l,ipoint) &
|
||||
!$OMP SHARED (m,mo_num,n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP lk_grad_mi)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i=1,mo_num
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
|
||||
lk_grad_mi(ipoint,1,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,1,m,i) * final_weight_at_r_vector(ipoint)
|
||||
lk_grad_mi(ipoint,2,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,2,m,i) * final_weight_at_r_vector(ipoint)
|
||||
lk_grad_mi(ipoint,3,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,3,m,i) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(lm_grad_ik)
|
||||
|
||||
allocate(lk_grad_mi(n_points_final_grid,3,mo_num,mo_num))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i,l,ipoint) &
|
||||
!$OMP SHARED (m,mo_num,n_points_final_grid, &
|
||||
!$OMP mos_l_in_r_array_transp, mos_r_in_r_array_transp, &
|
||||
!$OMP int2_grad1_u12_bimo_t, final_weight_at_r_vector, &
|
||||
!$OMP lk_grad_mi)
|
||||
!$OMP DO COLLAPSE(2)
|
||||
do i=1,mo_num
|
||||
do l=1,mo_num
|
||||
do ipoint=1, n_points_final_grid
|
||||
|
||||
lk_grad_mi(ipoint,1,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,1,m,i) * final_weight_at_r_vector(ipoint)
|
||||
lk_grad_mi(ipoint,2,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,2,m,i) * final_weight_at_r_vector(ipoint)
|
||||
lk_grad_mi(ipoint,3,l,i) = mos_l_in_r_array_transp(ipoint,l) * int2_grad1_u12_bimo_t(ipoint,3,m,i) * final_weight_at_r_vector(ipoint)
|
||||
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lk_grad_mi, 3*n_points_final_grid, &
|
||||
rm_grad_ik, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lk_grad_mi, 3*n_points_final_grid, &
|
||||
rm_grad_ik, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) - tmp_mat(k,j,l,i)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) - tmp_mat(l,i,k,j)
|
||||
three_e_5_idx_exch23_bi_ort (m,l,j,k,i) = three_e_5_idx_exch23_bi_ort (m,l,j,k,i) - tmp_mat(l,j,k,i)
|
||||
three_e_5_idx_exch13_bi_ort (m,l,j,k,i) = three_e_5_idx_exch13_bi_ort (m,l,j,k,i) - tmp_mat(k,i,l,j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lk_grad_mi, 3*n_points_final_grid, &
|
||||
rk_grad_im, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('T','N', mo_num*mo_num, mo_num*mo_num, 3*n_points_final_grid, 1.d0, &
|
||||
lk_grad_mi, 3*n_points_final_grid, &
|
||||
rk_grad_im, 3*n_points_final_grid, 0.d0, &
|
||||
tmp_mat, mo_num*mo_num)
|
||||
|
||||
!$OMP PARALLEL DO PRIVATE(i,j,k,l)
|
||||
do i = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do l = 1, mo_num
|
||||
three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) - tmp_mat(l,j,i,k)
|
||||
three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) - tmp_mat(k,i,j,l)
|
||||
three_e_5_idx_exch23_bi_ort (m,l,j,k,i) = three_e_5_idx_exch23_bi_ort (m,l,j,k,i) - tmp_mat(k,j,i,l)
|
||||
three_e_5_idx_exch13_bi_ort (m,l,j,k,i) = three_e_5_idx_exch13_bi_ort (m,l,j,k,i) - tmp_mat(l,i,j,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(lk_grad_mi)
|
||||
deallocate(rm_grad_ik)
|
||||
deallocate(rk_grad_im)
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
deallocate(lk_grad_mi)
|
||||
deallocate(rm_grad_ik)
|
||||
deallocate(rk_grad_im)
|
||||
enddo
|
||||
|
||||
deallocate(tmp_mat)
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for three_e_5_idx_bi_ort', wall1 - wall0
|
||||
|
@ -9,8 +9,7 @@ subroutine provide_all_three_ints_bi_ortho
|
||||
PROVIDE three_e_3_idx_exch23_bi_ort three_e_3_idx_exch13_bi_ort three_e_3_idx_exch12_bi_ort
|
||||
endif
|
||||
if(three_e_4_idx_term)then
|
||||
PROVIDE three_e_4_idx_direct_bi_ort three_e_4_idx_cycle_1_bi_ort three_e_4_idx_cycle_2_bi_ort
|
||||
PROVIDE three_e_4_idx_exch23_bi_ort three_e_4_idx_exch13_bi_ort three_e_4_idx_exch12_bi_ort
|
||||
PROVIDE three_e_4_idx_direct_bi_ort three_e_4_idx_cycle_1_bi_ort three_e_4_idx_exch23_bi_ort three_e_4_idx_exch13_bi_ort
|
||||
endif
|
||||
if(.not.double_normal_ord.and.three_e_5_idx_term)then
|
||||
PROVIDE three_e_5_idx_direct_bi_ort
|
||||
|
@ -243,7 +243,9 @@ subroutine fock_ac_tc_operator(iorb,ispin,key, h_fock,p_fock, ispin_fock,hthree,
|
||||
do j = 1, nb
|
||||
jj = occ(j,other_spin)
|
||||
direct_int = three_e_4_idx_direct_bi_ort(jj,iorb,p_fock,h_fock) ! USES 4-IDX TENSOR
|
||||
exchange_int = three_e_4_idx_exch12_bi_ort(jj,iorb,p_fock,h_fock) ! USES 4-IDX TENSOR
|
||||
! TODO
|
||||
! use transpose
|
||||
exchange_int = three_e_4_idx_exch13_bi_ort(iorb,jj,p_fock,h_fock) ! USES 4-IDX TENSOR
|
||||
hthree += direct_int - exchange_int
|
||||
enddo
|
||||
else !! ispin NE to ispin_fock
|
||||
@ -322,7 +324,8 @@ subroutine fock_a_tc_operator(iorb,ispin,key, h_fock,p_fock, ispin_fock,hthree,N
|
||||
do j = 1, nb
|
||||
jj = occ(j,other_spin)
|
||||
direct_int = three_e_4_idx_direct_bi_ort(jj,iorb,p_fock,h_fock) ! USES 4-IDX TENSOR
|
||||
exchange_int = three_e_4_idx_exch12_bi_ort(jj,iorb,p_fock,h_fock) ! USES 4-IDX TENSOR
|
||||
! TODO use transpose
|
||||
exchange_int = three_e_4_idx_exch13_bi_ort(iorb,jj,p_fock,h_fock) ! USES 4-IDX TENSOR
|
||||
hthree -= direct_int - exchange_int
|
||||
enddo
|
||||
else !! ispin NE to ispin_fock
|
||||
|
@ -96,9 +96,11 @@ double precision function three_e_single_parrallel_spin(m,j,k,i)
|
||||
implicit none
|
||||
integer, intent(in) :: i,k,j,m
|
||||
three_e_single_parrallel_spin = three_e_4_idx_direct_bi_ort(m,j,k,i) ! direct
|
||||
three_e_single_parrallel_spin += three_e_4_idx_cycle_1_bi_ort(m,j,k,i) + three_e_4_idx_cycle_2_bi_ort(m,j,k,i) & ! two cyclic permutations
|
||||
three_e_single_parrallel_spin += three_e_4_idx_cycle_1_bi_ort(m,j,k,i) + three_e_4_idx_cycle_1_bi_ort(j,m,k,i) & ! two cyclic permutations
|
||||
- three_e_4_idx_exch23_bi_ort(m,j,k,i) - three_e_4_idx_exch13_bi_ort(m,j,k,i) & ! two first exchange
|
||||
- three_e_4_idx_exch12_bi_ort(m,j,k,i) ! last exchange
|
||||
- three_e_4_idx_exch13_bi_ort(j,m,k,i) ! last exchange
|
||||
! TODO
|
||||
! use transpose
|
||||
end
|
||||
|
||||
double precision function three_e_double_parrallel_spin(m,l,j,k,i)
|
||||
|
Loading…
Reference in New Issue
Block a user