mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-09-12 10:48:31 +02:00
BI-AO --> BI-MO with DGEMM
This commit is contained in:
parent
5a5071f248
commit
3940eaeb78
@ -80,6 +80,8 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
FREE ao_tc_int_chemist
|
||||||
|
|
||||||
endif
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
@ -128,69 +130,99 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num,
|
|||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i, j, k, l, m, n, p, q
|
integer :: i, j, k, l, m, n, p, q
|
||||||
double precision, allocatable :: mo_tmp_1(:,:,:,:), mo_tmp_2(:,:,:,:)
|
double precision, allocatable :: a1(:,:,:,:), a2(:,:,:,:)
|
||||||
|
|
||||||
allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
|
PROVIDE mo_r_coef mo_l_coef
|
||||||
mo_tmp_1 = 0.d0
|
|
||||||
|
|
||||||
do m = 1, ao_num
|
allocate(a2(ao_num,ao_num,ao_num,mo_num))
|
||||||
do p = 1, ao_num
|
|
||||||
do n = 1, ao_num
|
|
||||||
do q = 1, ao_num
|
|
||||||
do k = 1, mo_num
|
|
||||||
! (k n|p m) = sum_q c_qk * (q n|p m)
|
|
||||||
mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
|
call dgemm( 'T', 'N', ao_num*ao_num*ao_num, mo_num, ao_num, 1.d0 &
|
||||||
mo_tmp_2 = 0.d0
|
, ao_two_e_tc_tot(1,1,1,1), ao_num, mo_l_coef(1,1), ao_num &
|
||||||
|
, 0.d0 , a2(1,1,1,1), ao_num*ao_num*ao_num)
|
||||||
|
|
||||||
do m = 1, ao_num
|
allocate(a1(ao_num,ao_num,mo_num,mo_num))
|
||||||
do p = 1, ao_num
|
|
||||||
do n = 1, ao_num
|
|
||||||
do i = 1, mo_num
|
|
||||||
do k = 1, mo_num
|
|
||||||
! (k i|p m) = sum_n c_ni * (k n|p m)
|
|
||||||
mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
deallocate(mo_tmp_1)
|
|
||||||
|
|
||||||
allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
|
call dgemm( 'T', 'N', ao_num*ao_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||||
mo_tmp_1 = 0.d0
|
, a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num &
|
||||||
do m = 1, ao_num
|
, 0.d0, a1(1,1,1,1), ao_num*ao_num*mo_num)
|
||||||
do p = 1, ao_num
|
|
||||||
do l = 1, mo_num
|
|
||||||
do i = 1, mo_num
|
|
||||||
do k = 1, mo_num
|
|
||||||
mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
deallocate(mo_tmp_2)
|
|
||||||
|
|
||||||
mo_bi_ortho_tc_two_e_chemist = 0.d0
|
deallocate(a2)
|
||||||
do m = 1, ao_num
|
allocate(a2(ao_num,mo_num,mo_num,mo_num))
|
||||||
do j = 1, mo_num
|
|
||||||
do l = 1, mo_num
|
call dgemm( 'T', 'N', ao_num*mo_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||||
do i = 1, mo_num
|
, a1(1,1,1,1), ao_num, mo_l_coef(1,1), ao_num &
|
||||||
do k = 1, mo_num
|
, 0.d0, a2(1,1,1,1), ao_num*mo_num*mo_num)
|
||||||
mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * mo_tmp_1(k,i,l,m)
|
|
||||||
enddo
|
deallocate(a1)
|
||||||
enddo
|
|
||||||
enddo
|
call dgemm( 'T', 'N', mo_num*mo_num*mo_num, mo_num, ao_num, 1.d0 &
|
||||||
enddo
|
, a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num &
|
||||||
enddo
|
, 0.d0, mo_bi_ortho_tc_two_e_chemist(1,1,1,1), mo_num*mo_num*mo_num)
|
||||||
deallocate(mo_tmp_1)
|
|
||||||
|
deallocate(a2)
|
||||||
|
|
||||||
|
|
||||||
|
!allocate(a1(mo_num,ao_num,ao_num,ao_num))
|
||||||
|
!a1 = 0.d0
|
||||||
|
|
||||||
|
!do m = 1, ao_num
|
||||||
|
! do p = 1, ao_num
|
||||||
|
! do n = 1, ao_num
|
||||||
|
! do q = 1, ao_num
|
||||||
|
! do k = 1, mo_num
|
||||||
|
! ! (k n|p m) = sum_q c_qk * (q n|p m)
|
||||||
|
! a1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
|
||||||
|
!allocate(a2(mo_num,mo_num,ao_num,ao_num))
|
||||||
|
!a2 = 0.d0
|
||||||
|
|
||||||
|
!do m = 1, ao_num
|
||||||
|
! do p = 1, ao_num
|
||||||
|
! do n = 1, ao_num
|
||||||
|
! do i = 1, mo_num
|
||||||
|
! do k = 1, mo_num
|
||||||
|
! ! (k i|p m) = sum_n c_ni * (k n|p m)
|
||||||
|
! a2(k,i,p,m) += mo_r_coef_transp(i,n) * a1(k,n,p,m)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
!deallocate(a1)
|
||||||
|
|
||||||
|
!allocate(a1(mo_num,mo_num,mo_num,ao_num))
|
||||||
|
!a1 = 0.d0
|
||||||
|
!do m = 1, ao_num
|
||||||
|
! do p = 1, ao_num
|
||||||
|
! do l = 1, mo_num
|
||||||
|
! do i = 1, mo_num
|
||||||
|
! do k = 1, mo_num
|
||||||
|
! a1(k,i,l,m) += mo_l_coef_transp(l,p) * a2(k,i,p,m)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
!deallocate(a2)
|
||||||
|
|
||||||
|
!mo_bi_ortho_tc_two_e_chemist = 0.d0
|
||||||
|
!do m = 1, ao_num
|
||||||
|
! do j = 1, mo_num
|
||||||
|
! do l = 1, mo_num
|
||||||
|
! do i = 1, mo_num
|
||||||
|
! do k = 1, mo_num
|
||||||
|
! mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * a1(k,i,l,m)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
!deallocate(a1)
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
@ -209,6 +241,8 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num,
|
|||||||
implicit none
|
implicit none
|
||||||
integer :: i, j, k, l
|
integer :: i, j, k, l
|
||||||
|
|
||||||
|
PROVIDE mo_bi_ortho_tc_two_e_chemist
|
||||||
|
|
||||||
do j = 1, mo_num
|
do j = 1, mo_num
|
||||||
do i = 1, mo_num
|
do i = 1, mo_num
|
||||||
do l = 1, mo_num
|
do l = 1, mo_num
|
||||||
@ -220,6 +254,8 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num,
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
FREE mo_bi_ortho_tc_two_e_chemist
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
@ -119,6 +119,7 @@ BEGIN_PROVIDER [double precision, ao_tc_int_chemist_no_cycle, (ao_num, ao_num, a
|
|||||||
|
|
||||||
call wall_time(wall1)
|
call wall_time(wall1)
|
||||||
print *, ' wall time for ao_tc_int_chemist_no_cycle ', wall1 - wall0
|
print *, ' wall time for ao_tc_int_chemist_no_cycle ', wall1 - wall0
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
44
src/tc_bi_ortho/print_tc_dump.irp.f
Normal file
44
src/tc_bi_ortho/print_tc_dump.irp.f
Normal file
@ -0,0 +1,44 @@
|
|||||||
|
program tc_bi_ortho
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
my_grid_becke = .True.
|
||||||
|
my_n_pt_r_grid = 30
|
||||||
|
my_n_pt_a_grid = 50
|
||||||
|
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||||
|
|
||||||
|
call KMat_tilde_dump()
|
||||||
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine KMat_tilde_dump()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, k, l
|
||||||
|
|
||||||
|
PROVIDE mo_bi_ortho_tc_two_e_chemist
|
||||||
|
|
||||||
|
print *, ' Kmat_tilde in chem notation'
|
||||||
|
|
||||||
|
open(33, file='Kmat_tilde.dat', action='write')
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
write(33, '(4(I4, 2X), 4X, E15.7)') i, j, k, l, mo_bi_ortho_tc_two_e_chemist(i,j,k,l)
|
||||||
|
! TCHint convention
|
||||||
|
!write(33, '(4(I4, 2X), 4X, E15.7)') i, j, k, l, mo_bi_ortho_tc_two_e_chemist(j,i,l,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
close(33)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine KMat_tilde_dump
|
||||||
|
|
||||||
|
! ---
|
Loading…
Reference in New Issue
Block a user