9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-10-10 01:43:06 +02:00
qp2/src/bitmask/bitmasks_routines.irp.f
2019-01-25 11:39:31 +01:00

216 lines
5.8 KiB
Fortran

subroutine set_bit_to_integer(i_physical,key,Nint)
use bitmasks
BEGIN_DOC
! set to 1 the bit number i_physical in the bitstring key
END_DOC
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
BEGIN_DOC
! set to 0 the bit number i_physical in the bitstring key
END_DOC
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
subroutine bitstring_to_list( string, list, n_elements, Nint)
use bitmasks
implicit none
BEGIN_DOC
! Gives the inidices(+1) of the bits set to 1 in the bit string
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: string(Nint)
integer, intent(out) :: list(Nint*bit_kind_size)
integer, intent(out) :: n_elements
integer :: i, ishift
integer(bit_kind) :: l
n_elements = 0
ishift = 2
do i=1,Nint
l = string(i)
do while (l /= 0_bit_kind)
n_elements = n_elements+1
list(n_elements) = ishift+popcnt(l-1_bit_kind) - popcnt(l)
l = iand(l,l-1_bit_kind)
enddo
ishift = ishift + bit_kind_size
enddo
end
subroutine list_to_bitstring( string, list, n_elements, Nint)
use bitmasks
implicit none
BEGIN_DOC
! Returns the physical string "string(N_int,2)" from the array of
! occupations "list(N_int*bit_kind_size,2)
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(out) :: string(Nint)
integer, intent(in) :: list(Nint*bit_kind_size)
integer, intent(in) :: n_elements
integer :: i, j
integer :: ipos, iint
!
! <== ipos ==>
! |
! v
!string :|------------------------|-------------------------|------------------------|
! <==== bit_kind_size ====> <==== bit_kind_size ====> <==== bit_kind_size ====>
! { iint } { iint } { iint }
!
string = 0_bit_kind
do i=1,n_elements
iint = shiftr(list(i)-1,bit_kind_shift) + 1
ipos = list(i)-shiftl((iint-1),bit_kind_shift)-1
string(iint) = ibset( string(iint), ipos )
enddo
end
subroutine bitstring_to_str( output, string, Nint )
use bitmasks
implicit none
BEGIN_DOC
! Transform a bit string to a string for printing
END_DOC
character*(*), intent(out) :: output
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: string(Nint)
integer :: i, j, ibuf
integer(bit_kind) :: itemp
ibuf = 1
output = ''
output(ibuf:ibuf) = '|'
ibuf = ibuf+1
do i=1,Nint
itemp = 1_bit_kind
do j=1,bit_kind_size
if (iand(itemp,string(i)) == itemp) then
output(ibuf:ibuf) = '+'
else
output(ibuf:ibuf) = '-'
endif
ibuf = ibuf+1
itemp = shiftl(itemp,1)
enddo
enddo
output(ibuf:ibuf) = '|'
end
subroutine bitstring_to_hexa( output, string, Nint )
use bitmasks
implicit none
BEGIN_DOC
! Transform a bit string to a string in hexadecimal format for printing
END_DOC
character*(*), intent(out) :: output
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: string(Nint)
integer :: i, j, ibuf
integer(bit_kind) :: itemp
character*(32) :: f
write(f,*) '(Z',bit_kind_size/4,'.',bit_kind_size/4,')'
ibuf = 1
output = ''
do i=Nint,1,-1
write(output(ibuf:ibuf+bit_kind_size/4),f) string(i)
ibuf = ibuf+bit_kind_size/4
enddo
end
subroutine debug_det(string,Nint)
use bitmasks
implicit none
BEGIN_DOC
! Subroutine to print the content of a determinant in '+-' notation and
! hexadecimal representation.
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: string(Nint,2)
character*(2048) :: output(2)
call bitstring_to_hexa( output(1), string(1,1), Nint )
call bitstring_to_hexa( output(2), string(1,2), Nint )
print *, trim(output(1)) , '|', trim(output(2))
call print_det(string,Nint)
end
subroutine print_det(string,Nint)
use bitmasks
implicit none
BEGIN_DOC
! Subroutine to print the content of a determinant using the '+-' notation
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: string(Nint,2)
character*(2048) :: output(2)
call bitstring_to_str( output(1), string(1,1), Nint )
call bitstring_to_str( output(2), string(1,2), Nint )
print *, trim(output(1))
print *, trim(output(2))
end
subroutine debug_spindet(string,Nint)
use bitmasks
implicit none
BEGIN_DOC
! Subroutine to print the content of a determinant in '+-' notation and
! hexadecimal representation.
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: string(Nint,2)
character*(2048) :: output(1)
call bitstring_to_hexa( output(1), string(1,1), Nint )
print *, trim(output(1))
call print_spindet(string,Nint)
end
subroutine print_spindet(string,Nint)
use bitmasks
implicit none
BEGIN_DOC
! Subroutine to print the content of a determinant using the '+-' notation
END_DOC
integer, intent(in) :: Nint
integer(bit_kind), intent(in) :: string(Nint,2)
character*(2048) :: output(1)
call bitstring_to_str( output(1), string(1,1), Nint )
print *, trim(output(1))
end