LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-31 07:35:38 +01:00
Code Releases Activity

working on the matrix elements both

Browse Source
This commit is contained in:
eginer 2024-05-07 20:32:48 +02:00
parent 18fd70f1b8
commit 687259c25f
4 changed files with 264 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
plugins/local/bi_ort_ints/total_twoe_pot.irp.f
View File

@ -332,3 +332,23 @@ END_PROVIDER
! ---
BEGIN_PROVIDER [double precision, tc_2e_3idx_coulomb_integrals_transp , (mo_num,mo_num,mo_num)]
&BEGIN_PROVIDER [double precision, tc_2e_3idx_exchange_integrals_transp, (mo_num,mo_num,mo_num)]
BEGIN_DOC
! tc_2e_3idx_coulomb_integrals_transp (j,k,i) = <jk|ji>
! tc_2e_3idx_exchange_integrals_transp(j,k,i) = <kj|ji>
END_DOC
implicit none
integer :: i, j, k
do i = 1, mo_num
do k = 1, mo_num
do j = 1, mo_num
tc_2e_3idx_coulomb_integrals_transp(j, k,i) = mo_bi_ortho_tc_two_e_transp(j ,k ,j ,i )
tc_2e_3idx_exchange_integrals_transp(j,k,i) = mo_bi_ortho_tc_two_e_transp(k ,j ,j ,i )
enddo
enddo
enddo
END_PROVIDER

42
plugins/local/slater_tc/slater_tc_opt.irp.f
View File

@ -181,3 +181,45 @@ end
! ---
subroutine htilde_mu_mat_opt_bi_ortho_no_3e_both(key_j, key_i, Nint, htot)
BEGIN_DOC
!
! <key_j |H_tilde | key_i> where |key_j> is developed on the LEFT basis and |key_i> is developed on the RIGHT basis
!!
! Returns the detail of the matrix element WITHOUT ANY CONTRIBUTION FROM THE THREE ELECTRON TERMS
!! WARNING !!
!
! Non hermitian !!
!
END_DOC
use bitmasks
implicit none
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
double precision, intent(out) :: htot
integer :: degree
htot = 0.d0
call get_excitation_degree(key_i, key_j, degree, Nint)
if(degree.gt.2) return
if(degree == 0) then
call diag_htilde_mu_mat_fock_bi_ortho_no_3e(Nint, key_i,htot)
else if (degree == 1) then
call single_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint,key_j, key_i , htot)
else if(degree == 2) then
call double_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, htot)
endif
if(degree==0) then
htot += nuclear_repulsion
endif
end
! ---

60
plugins/local/slater_tc/slater_tc_opt_double.irp.f
View File

@ -505,3 +505,63 @@ subroutine double_htilde_mu_mat_fock_bi_ortho_no_3e(Nint, key_j, key_i, htot)
end
subroutine double_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, hji,hij)
BEGIN_DOC
! <key_j |H_tilde | key_i> and <key_i |H_tilde | key_j> for double excitation ONLY FOR ONE- AND TWO-BODY TERMS
!!
!! WARNING !!
!
! Non hermitian !!
END_DOC
use bitmasks
implicit none
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: key_j(Nint,2), key_i(Nint,2)
double precision, intent(out) :: hji,hij
double precision :: hmono, htwoe_ji, htwoe_ij
integer :: occ(Nint*bit_kind_size,2)
integer :: Ne(2), i, j, ii, jj, ispin, jspin, k, kk
integer :: degree,exc(0:2,2,2)
integer :: h1, p1, h2, p2, s1, s2
double precision :: get_mo_two_e_integral_tc_int,phase
call get_excitation_degree(key_i, key_j, degree, Nint)
hmono = 0.d0
htwoe_ji = 0.d0
htwoe_ij = 0.d0
hji = 0.d0
hij = 0.d0
if(degree.ne.2)then
return
endif
integer :: degree_i,degree_j
call get_excitation_degree(ref_bitmask,key_i,degree_i,N_int)
call get_excitation_degree(ref_bitmask,key_j,degree_j,N_int)
call get_double_excitation(key_i, key_j, exc, phase, Nint)
call decode_exc(exc, 2, h1, p1, h2, p2, s1, s2)
if(s1.ne.s2)then
! opposite spin two-body
htwoe_ji = mo_bi_ortho_tc_two_e(p2,p1,h2,h1)
htwoe_ij = mo_bi_ortho_tc_two_e_transp(p2,p1,h2,h1)
else
! same spin two-body
! direct terms
htwoe_ji = mo_bi_ortho_tc_two_e(p2,p1,h2,h1)
htwoe_ij = mo_bi_ortho_tc_two_e_transp(p2,p1,h2,h1)
! exchange terms
htwoe_ji -= mo_bi_ortho_tc_two_e(p1,p2,h2,h1)
htwoe_ij -= mo_bi_ortho_tc_two_e_transp(p1,p2,h2,h1)
endif
htwoe_ji *= phase
hji = htwoe_ji
htwoe_ij *= phase
hij = htwoe_ij
end

142
plugins/local/slater_tc/slater_tc_opt_single.irp.f
View File

@ -618,3 +618,145 @@ subroutine get_single_excitation_from_fock_tc_no_3e(Nint, key_i, key_j, h, p, sp
end
subroutine single_htilde_mu_mat_fock_bi_ortho_no_3e_both(Nint, key_j, key_i, hji,hij)
BEGIN_DOC
! <key_j |H_tilde | key_i> and <key_i |H_tilde | key_j> for single excitation ONLY FOR ONE- AND TWO-BODY TERMS
!!
!! WARNING !!
!
! Non hermitian !!
END_DOC
use bitmasks
implicit none
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: key_j(Nint,2), key_i(Nint,2)
double precision, intent(out) :: hji,hij
double precision :: hmono, htwoe
integer :: occ(Nint*bit_kind_size,2)
integer :: Ne(2), i, j, ii, jj, ispin, jspin, k, kk
integer :: degree,exc(0:2,2,2)
integer :: h1, p1, h2, p2, s1, s2
double precision :: get_mo_two_e_integral_tc_int, phase
double precision :: direct_int, exchange_int_12, exchange_int_23, exchange_int_13
integer :: other_spin(2)
integer(bit_kind) :: key_j_core(Nint,2), key_i_core(Nint,2)
other_spin(1) = 2
other_spin(2) = 1
hmono = 0.d0
htwoe = 0.d0
hji = 0.d0
hji = 0.d0
call get_excitation_degree(key_i, key_j, degree, Nint)
if(degree.ne.1)then
return
endif
call bitstring_to_list_ab(key_i, occ, Ne, Nint)
call get_single_excitation(key_i, key_j, exc, phase, Nint)
call decode_exc(exc,1,h1,p1,h2,p2,s1,s2)
call get_single_excitation_from_fock_tc_no_3e_both(Nint, key_i, key_j, h1, p1, s1, phase, hmono, htwoe, hji,hij)
end
! ---
subroutine get_single_excitation_from_fock_tc_no_3e_both(Nint, key_i, key_j, h, p, spin, phase, hji,hij)
use bitmasks
implicit none
integer, intent(in) :: Nint
integer, intent(in) :: h, p, spin
double precision, intent(in) :: phase
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
double precision, intent(out) :: hji,hij
double precision :: hmono_ji,htwoe_ji
double precision :: hmono_ij,htwoe_ij
integer(bit_kind) :: differences(Nint,2)
integer(bit_kind) :: hole(Nint,2)
integer(bit_kind) :: partcl(Nint,2)
integer :: occ_hole(Nint*bit_kind_size,2)
integer :: occ_partcl(Nint*bit_kind_size,2)
integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2)
integer :: i0,i
double precision :: buffer_c_ji(mo_num), buffer_x_ji(mo_num)
double precision :: buffer_c_ij(mo_num), buffer_x_ij(mo_num)
do i = 1, mo_num
buffer_c_ji(i) = tc_2e_3idx_coulomb_integrals(i,p,h)
buffer_x_ji(i) = tc_2e_3idx_exchange_integrals(i,p,h)
buffer_c_ij(i) = tc_2e_3idx_coulomb_integrals_transp(i,p,h)
buffer_x_ij(i) = tc_2e_3idx_exchange_integrals_transp(i,p,h)
enddo
do i = 1, Nint
differences(i,1) = xor(key_i(i,1),ref_closed_shell_bitmask(i,1))
differences(i,2) = xor(key_i(i,2),ref_closed_shell_bitmask(i,2))
hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1))
hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2))
partcl(i,1) = iand(differences(i,1),key_i(i,1))
partcl(i,2) = iand(differences(i,2),key_i(i,2))
enddo
call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, Nint)
call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, Nint)
hmono_ji = mo_bi_ortho_tc_one_e(p,h)
htwoe_ji = fock_op_2_e_tc_closed_shell(p,h)
hmono_ij = mo_bi_ortho_tc_one_e(h,p)
htwoe_ij = fock_op_2_e_tc_closed_shell(h,p)
! holes :: direct terms
do i0 = 1, n_occ_ab_hole(1)
i = occ_hole(i0,1)
htwoe_ji -= buffer_c_ji(i)
htwoe_ij -= buffer_c_ij(i)
enddo
do i0 = 1, n_occ_ab_hole(2)
i = occ_hole(i0,2)
htwoe_ji -= buffer_c_ji(i)
htwoe_ij -= buffer_c_ij(i)
enddo
! holes :: exchange terms
do i0 = 1, n_occ_ab_hole(spin)
i = occ_hole(i0,spin)
htwoe_ji += buffer_x_ji(i)
htwoe_ij += buffer_x_ij(i)
enddo
! particles :: direct terms
do i0 = 1, n_occ_ab_partcl(1)
i = occ_partcl(i0,1)
htwoe_ji += buffer_c_ji(i)
htwoe_ij += buffer_c_ij(i)
enddo
do i0 = 1, n_occ_ab_partcl(2)
i = occ_partcl(i0,2)
htwoe_ji += buffer_c_ji(i)
htwoe_ij += buffer_c_ij(i)
enddo
! particles :: exchange terms
do i0 = 1, n_occ_ab_partcl(spin)
i = occ_partcl(i0,spin)
htwoe_ji -= buffer_x_ji(i)
htwoe_ij -= buffer_x_ij(i)
enddo
htwoe_ji = htwoe_ji * phase
hmono_ji = hmono_ji * phase
hji = htwoe_ji + hmono_ji
htwoe_ij = htwoe_ij * phase
hmono_ij = hmono_ij * phase
hij = htwoe_ij + hmono_ij
end