mirror of
https://github.com/LCPQ/quantum_package
synced 2024-06-19 19:52:15 +02:00
61 lines
1.6 KiB
Fortran
61 lines
1.6 KiB
Fortran
subroutine do_mono_excitation(key_in,i_hole,i_particle,ispin,i_ok)
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Apply the mono excitation operator : a^{dager}_(i_particle) a_(i_hole) of spin = ispin
|
|
! on key_in
|
|
! ispin = 1 == alpha
|
|
! ispin = 2 == beta
|
|
! i_ok = 1 == the excitation is possible
|
|
! i_ok = -1 == the excitation is not possible
|
|
END_DOC
|
|
integer, intent(in) :: i_hole,i_particle,ispin
|
|
integer(bit_kind), intent(inout) :: key_in(N_int,2)
|
|
integer, intent(out) :: i_ok
|
|
integer :: k,j,i
|
|
use bitmasks
|
|
ASSERT (i_hole > 0 )
|
|
ASSERT (i_particle <= mo_tot_num)
|
|
i_ok = 1
|
|
! hole
|
|
k = ishft(i_hole-1,-bit_kind_shift)+1
|
|
j = i_hole-ishft(k-1,bit_kind_shift)-1
|
|
key_in(k,ispin) = ibclr(key_in(k,ispin),j)
|
|
|
|
! particle
|
|
k = ishft(i_particle-1,-bit_kind_shift)+1
|
|
j = i_particle-ishft(k-1,bit_kind_shift)-1
|
|
key_in(k,ispin) = ibset(key_in(k,ispin),j)
|
|
integer :: n_elec_tmp
|
|
n_elec_tmp = 0
|
|
do i = 1, N_int
|
|
n_elec_tmp += popcnt(key_in(i,1)) + popcnt(key_in(i,2))
|
|
enddo
|
|
if(n_elec_tmp .ne. elec_num)then
|
|
i_ok = -1
|
|
endif
|
|
end
|
|
|
|
subroutine set_bit_to_integer(i_physical,key,Nint)
|
|
use bitmasks
|
|
implicit none
|
|
integer, intent(in) :: i_physical,Nint
|
|
integer(bit_kind), intent(inout) :: key(Nint)
|
|
integer :: k,j,i
|
|
k = ishft(i_physical-1,-bit_kind_shift)+1
|
|
j = i_physical-ishft(k-1,bit_kind_shift)-1
|
|
key(k) = ibset(key(k),j)
|
|
end
|
|
|
|
|
|
subroutine clear_bit_to_integer(i_physical,key,Nint)
|
|
use bitmasks
|
|
implicit none
|
|
integer, intent(in) :: i_physical,Nint
|
|
integer(bit_kind), intent(inout) :: key(Nint)
|
|
integer :: k,j,i
|
|
k = ishft(i_physical-1,-bit_kind_shift)+1
|
|
j = i_physical-ishft(k-1,bit_kind_shift)-1
|
|
key(k) = ibclr(key(k),j)
|
|
end
|
|
|