mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-23 21:03:49 +01:00
complex slater_rules_wee_mono
This commit is contained in:
Kevin Gasperich
parent
5ee3fc6e43
commit
0e31cfee7f
@ -361,3 +361,195 @@ subroutine i_H_j_two_e(key_i,key_j,Nint,hij)
|
|||||||
end select
|
end select
|
||||||
end
|
end
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Complex !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
subroutine i_Wee_j_single_complex(key_i,key_j,Nint,spin,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by a
|
||||||
|
! single excitation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint, spin
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2)
|
||||||
|
double precision :: phase
|
||||||
|
|
||||||
|
PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||||
|
call single_excitation_wee_complex(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_j_mono_spin_one_e_complex(key_i,key_j,Nint,spin,hij)
|
||||||
|
!todo: check hole/particle m/p ordering?
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by
|
||||||
|
! a single excitation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint, spin
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2)
|
||||||
|
double precision :: phase
|
||||||
|
|
||||||
|
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||||
|
integer :: m,p
|
||||||
|
m = exc(1,1)
|
||||||
|
p = exc(1,2)
|
||||||
|
hij = phase * mo_one_e_integrals_complex(m,p)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine i_H_j_one_e_complex(key_i,key_j,Nint,hij)
|
||||||
|
!todo: check hole/particle m/p ordering?
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: degree,m,p
|
||||||
|
double precision :: diag_h_mat_elem_one_e,phase
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
if(degree>1)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
if(degree==0)then
|
||||||
|
hij = dcmplx(diag_H_mat_elem_one_e(key_i,N_int),0.d0)
|
||||||
|
else
|
||||||
|
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Mono alpha
|
||||||
|
m = exc(1,1,1)
|
||||||
|
p = exc(1,2,1)
|
||||||
|
else
|
||||||
|
! Mono beta
|
||||||
|
m = exc(1,1,2)
|
||||||
|
p = exc(1,2,2)
|
||||||
|
endif
|
||||||
|
hij = phase * mo_one_e_integrals_complex(m,p)
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine i_H_j_two_e_complex(key_i,key_j,Nint,hij)
|
||||||
|
!todo: check hole/particle m/p ordering?
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
integer :: degree
|
||||||
|
complex*16 :: get_two_e_integral_complex
|
||||||
|
integer :: m,n,p,q
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
double precision :: diag_H_mat_elem, phase,phase_2
|
||||||
|
integer :: n_occ_ab(2)
|
||||||
|
PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex ref_bitmask_two_e_energy
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num)
|
||||||
|
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||||
|
integer :: spin
|
||||||
|
select case (degree)
|
||||||
|
case (2)
|
||||||
|
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Mono alpha, mono beta
|
||||||
|
if(exc(1,1,1) == exc(1,2,2) )then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1))
|
||||||
|
else if (exc(1,2,1) ==exc(1,1,2))then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2))
|
||||||
|
else
|
||||||
|
hij = phase*get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
endif
|
||||||
|
else if (exc(0,1,1) == 2) then
|
||||||
|
! Double alpha
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(2,2,1), &
|
||||||
|
exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
else if (exc(0,1,2) == 2) then
|
||||||
|
! Double beta
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(1,2,2), &
|
||||||
|
exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(2,2,2), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
endif
|
||||||
|
case (1)
|
||||||
|
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Mono alpha
|
||||||
|
m = exc(1,1,1)
|
||||||
|
p = exc(1,2,1)
|
||||||
|
spin = 1
|
||||||
|
else
|
||||||
|
! Mono beta
|
||||||
|
m = exc(1,1,2)
|
||||||
|
p = exc(1,2,2)
|
||||||
|
spin = 2
|
||||||
|
endif
|
||||||
|
call single_excitation_wee_complex(key_i,key_j,p,m,spin,phase,hij)
|
||||||
|
case (0)
|
||||||
|
double precision :: diag_wee_mat_elem
|
||||||
|
hij = dcmplx(diag_wee_mat_elem(key_i,Nint),0.d0)
|
||||||
|
end select
|
||||||
|
end
|
||||||
|
|||||||
@ -49,7 +49,7 @@ determinants:
|
|||||||
(****) slater_rules.irp.f
|
(****) slater_rules.irp.f
|
||||||
made copies of needed functions for complex
|
made copies of needed functions for complex
|
||||||
still need to do implementation
|
still need to do implementation
|
||||||
(****) slater_rules_wee_mono.irp.f
|
(done?) slater_rules_wee_mono.irp.f
|
||||||
(done) sort_dets_ab.irp.f
|
(done) sort_dets_ab.irp.f
|
||||||
spindeterminants.ezfio_config
|
spindeterminants.ezfio_config
|
||||||
need svd complex?
|
need svd complex?
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user