216 lines
5.3 KiB
Fortran
216 lines
5.3 KiB
Fortran
logical function det_inf(key1, key2, Nint)
|
|
use bitmasks
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Ordering function for determinants.
|
|
END_DOC
|
|
integer,intent(in) :: Nint
|
|
integer(bit_kind),intent(in) :: key1(Nint, 2), key2(Nint, 2)
|
|
integer :: i,j
|
|
|
|
det_inf = .false.
|
|
|
|
do i=1,2
|
|
do j=Nint,1,-1
|
|
if(key1(j,i) < key2(j,i)) then
|
|
det_inf = .true.
|
|
return
|
|
else if(key1(j,i) > key2(j,i)) then
|
|
return
|
|
end if
|
|
end do
|
|
end do
|
|
end function
|
|
|
|
|
|
subroutine tamiser(key, idx, no, n, Nint, N_key)
|
|
use bitmasks
|
|
implicit none
|
|
integer,intent(in) :: no, n, Nint, N_key
|
|
integer(bit_kind),intent(inout) :: key(Nint, 2, N_key)
|
|
integer,intent(inout) :: idx(N_key)
|
|
integer :: k,j,tmpidx
|
|
integer(bit_kind) :: tmp(Nint, 2)
|
|
logical :: det_inf
|
|
integer :: ni
|
|
|
|
k = no
|
|
j = 2*k
|
|
do while(j <= n)
|
|
if(j < n) then
|
|
if (det_inf(key(1,1,j), key(1,1,j+1), Nint)) then
|
|
j = j+1
|
|
endif
|
|
endif
|
|
if(det_inf(key(1,1,k), key(1,1,j), Nint)) then
|
|
do ni=1,Nint
|
|
tmp(ni,1) = key(ni,1,k)
|
|
tmp(ni,2) = key(ni,2,k)
|
|
key(ni,1,k) = key(ni,1,j)
|
|
key(ni,2,k) = key(ni,2,j)
|
|
key(ni,1,j) = tmp(ni,1)
|
|
key(ni,2,j) = tmp(ni,2)
|
|
enddo
|
|
tmpidx = idx(k)
|
|
idx(k) = idx(j)
|
|
idx(j) = tmpidx
|
|
k = j
|
|
j = k+k
|
|
else
|
|
return
|
|
endif
|
|
enddo
|
|
end subroutine
|
|
|
|
|
|
subroutine sort_dets_ba_v(key_in, key_out, idx, shortcut, version, N_key, Nint)
|
|
use bitmasks
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Deprecated routine
|
|
END_DOC
|
|
integer, intent(in) :: Nint, N_key
|
|
integer(bit_kind),intent(in) :: key_in(Nint,2,N_key)
|
|
integer(bit_kind),intent(out) :: key_out(Nint,N_key)
|
|
integer,intent(out) :: idx(N_key)
|
|
integer,intent(out) :: shortcut(0:N_key+1)
|
|
integer(bit_kind),intent(out) :: version(Nint,N_key+1)
|
|
integer(bit_kind), allocatable :: key(:,:,:)
|
|
integer :: i,ni
|
|
|
|
allocate ( key(Nint,2,N_key) )
|
|
do i=1,N_key
|
|
do ni=1,Nint
|
|
key(ni,1,i) = key_in(ni,2,i)
|
|
key(ni,2,i) = key_in(ni,1,i)
|
|
enddo
|
|
enddo
|
|
|
|
call sort_dets_ab_v(key, key_out, idx, shortcut, version, N_key, Nint)
|
|
deallocate ( key )
|
|
end subroutine
|
|
|
|
|
|
|
|
subroutine sort_dets_ab_v(key_in, key_out, idx, shortcut, version, N_key, Nint)
|
|
use bitmasks
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Deprecated routine
|
|
END_DOC
|
|
integer, intent(in) :: Nint, N_key
|
|
integer(bit_kind),intent(in) :: key_in(Nint,2,N_key)
|
|
integer(bit_kind),intent(out) :: key_out(Nint,N_key)
|
|
integer,intent(out) :: idx(N_key)
|
|
integer,intent(out) :: shortcut(0:N_key+1)
|
|
integer(bit_kind),intent(out) :: version(Nint,N_key+1)
|
|
integer(bit_kind), allocatable :: key(:,:,:)
|
|
integer(bit_kind) :: tmp(Nint, 2)
|
|
integer :: tmpidx,i,ni
|
|
|
|
allocate (key(Nint,2,N_key))
|
|
do i=1,N_key
|
|
do ni=1,Nint
|
|
key(ni,1,i) = key_in(ni,1,i)
|
|
key(ni,2,i) = key_in(ni,2,i)
|
|
enddo
|
|
idx(i) = i
|
|
end do
|
|
|
|
do i=N_key/2,1,-1
|
|
call tamiser(key, idx, i, N_key, Nint, N_key)
|
|
end do
|
|
|
|
do i=N_key,2,-1
|
|
do ni=1,Nint
|
|
tmp(ni,1) = key(ni,1,i)
|
|
tmp(ni,2) = key(ni,2,i)
|
|
key(ni,1,i) = key(ni,1,1)
|
|
key(ni,2,i) = key(ni,2,1)
|
|
key(ni,1,1) = tmp(ni,1)
|
|
key(ni,2,1) = tmp(ni,2)
|
|
enddo
|
|
tmpidx = idx(i)
|
|
idx(i) = idx(1)
|
|
idx(1) = tmpidx
|
|
call tamiser(key, idx, 1, i-1, Nint, N_key)
|
|
end do
|
|
|
|
shortcut(0) = 1
|
|
shortcut(1) = 1
|
|
do ni=1,Nint
|
|
version(ni,1) = key(ni,1,1)
|
|
enddo
|
|
do i=2,N_key
|
|
do ni=1,nint
|
|
if(key(ni,1,i) /= key(ni,1,i-1)) then
|
|
shortcut(0) = shortcut(0) + 1
|
|
shortcut(shortcut(0)) = i
|
|
version(:,shortcut(0)) = key(:,1,i)
|
|
exit
|
|
end if
|
|
end do
|
|
end do
|
|
shortcut(shortcut(0)+1) = N_key+1
|
|
do i=1,N_key
|
|
do ni=1,Nint
|
|
key_out(ni,i) = key(ni,2,i)
|
|
enddo
|
|
enddo
|
|
deallocate (key)
|
|
end subroutine
|
|
|
|
|
|
subroutine sort_dets_ab(key, idx, shortcut, N_key, Nint)
|
|
use bitmasks
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Deprecated routine
|
|
END_DOC
|
|
integer, intent(in) :: Nint, N_key
|
|
integer(bit_kind),intent(inout) :: key(Nint,2,N_key)
|
|
integer,intent(inout) :: idx(N_key)
|
|
integer,intent(inout) :: shortcut(0:N_key+1)
|
|
integer(bit_kind) :: tmp(Nint, 2)
|
|
integer :: tmpidx,i,ni
|
|
|
|
do i=1,N_key
|
|
idx(i) = i
|
|
end do
|
|
|
|
do i=N_key/2,1,-1
|
|
call tamiser(key, idx, i, N_key, Nint, N_key)
|
|
end do
|
|
|
|
do i=N_key,2,-1
|
|
do ni=1,Nint
|
|
tmp(ni,1) = key(ni,1,i)
|
|
tmp(ni,2) = key(ni,2,i)
|
|
key(ni,1,i) = key(ni,1,1)
|
|
key(ni,2,i) = key(ni,2,1)
|
|
key(ni,1,1) = tmp(ni,1)
|
|
key(ni,2,1) = tmp(ni,2)
|
|
enddo
|
|
|
|
tmpidx = idx(i)
|
|
idx(i) = idx(1)
|
|
idx(1) = tmpidx
|
|
call tamiser(key, idx, 1, i-1, Nint, N_key)
|
|
end do
|
|
|
|
shortcut(0) = 1
|
|
shortcut(1) = 1
|
|
do i=2,N_key
|
|
do ni=1,nint
|
|
if(key(ni,1,i) /= key(ni,1,i-1)) then
|
|
shortcut(0) = shortcut(0) + 1
|
|
shortcut(shortcut(0)) = i
|
|
exit
|
|
end if
|
|
end do
|
|
end do
|
|
shortcut(shortcut(0)+1) = N_key+1
|
|
end subroutine
|
|
|
|
|