diff --git a/src/bi_ort_ints/total_twoe_pot.irp.f b/src/bi_ort_ints/total_twoe_pot.irp.f index 721ea0c8..c1bacbd0 100644 --- a/src/bi_ort_ints/total_twoe_pot.irp.f +++ b/src/bi_ort_ints/total_twoe_pot.irp.f @@ -80,6 +80,8 @@ BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_n enddo enddo + FREE ao_tc_int_chemist + endif END_PROVIDER @@ -128,69 +130,99 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num, implicit none 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)) - mo_tmp_1 = 0.d0 + PROVIDE mo_r_coef mo_l_coef - 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) - 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(a2(ao_num,ao_num,ao_num,mo_num)) - allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num)) - mo_tmp_2 = 0.d0 + call dgemm( 'T', 'N', ao_num*ao_num*ao_num, mo_num, ao_num, 1.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 - 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(a1(ao_num,ao_num,mo_num,mo_num)) - allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num)) - mo_tmp_1 = 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 - 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) + call dgemm( 'T', 'N', ao_num*ao_num*mo_num, mo_num, ao_num, 1.d0 & + , a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num & + , 0.d0, a1(1,1,1,1), ao_num*ao_num*mo_num) - 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) * mo_tmp_1(k,i,l,m) - enddo - enddo - enddo - enddo - enddo - deallocate(mo_tmp_1) + deallocate(a2) + allocate(a2(ao_num,mo_num,mo_num,mo_num)) + + call dgemm( 'T', 'N', ao_num*mo_num*mo_num, mo_num, ao_num, 1.d0 & + , a1(1,1,1,1), ao_num, mo_l_coef(1,1), ao_num & + , 0.d0, a2(1,1,1,1), ao_num*mo_num*mo_num) + + deallocate(a1) + + call dgemm( 'T', 'N', mo_num*mo_num*mo_num, mo_num, ao_num, 1.d0 & + , a2(1,1,1,1), ao_num, mo_r_coef(1,1), ao_num & + , 0.d0, mo_bi_ortho_tc_two_e_chemist(1,1,1,1), mo_num*mo_num*mo_num) + + 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 @@ -209,6 +241,8 @@ BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num, implicit none integer :: i, j, k, l + PROVIDE mo_bi_ortho_tc_two_e_chemist + do j = 1, mo_num do i = 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 + FREE mo_bi_ortho_tc_two_e_chemist + END_PROVIDER ! --- diff --git a/src/non_h_ints_mu/total_tc_int.irp.f b/src/non_h_ints_mu/total_tc_int.irp.f index 2bdf39f0..158ee2fb 100644 --- a/src/non_h_ints_mu/total_tc_int.irp.f +++ b/src/non_h_ints_mu/total_tc_int.irp.f @@ -119,6 +119,7 @@ BEGIN_PROVIDER [double precision, ao_tc_int_chemist_no_cycle, (ao_num, ao_num, a call wall_time(wall1) print *, ' wall time for ao_tc_int_chemist_no_cycle ', wall1 - wall0 + END_PROVIDER ! --- diff --git a/src/tc_bi_ortho/print_tc_dump.irp.f b/src/tc_bi_ortho/print_tc_dump.irp.f new file mode 100644 index 00000000..327e0f02 --- /dev/null +++ b/src/tc_bi_ortho/print_tc_dump.irp.f @@ -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 + +! ---