9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-13 15:13:30 +01:00
qp2/src/cipsi/selection_buffer.irp.f

429 lines
9.7 KiB
Fortran
Raw Normal View History

2019-01-25 11:39:31 +01:00
Develop (#15) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * Add print_ci_vector in tools (#11) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Merge develop-toto and manus (#12) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop toto (#13) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop manus (#14) * modified printing for rpt2 * Comment * Fixed plugins * Scripting for functionals * Documentation * Develop (#10) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * some modifs * modified gfortran_debug.cfg * fixed automatization of functionals * modified e_xc_general.irp.f * minor modifs in ref_bitmask.irp.f * modifying functionals * rs_ks_scf and ks_scf compiles with the automatic handling of functionals * removed prints * fixed configure * fixed the new functionals * Merge toto * modified automatic functionals * Changed python into python2 * from_xyz suppressed * Cleaning repo * Update README.md * Update README.md * Contributors * Update GITHUB.md * bibtex
2019-03-07 16:29:06 +01:00
subroutine create_selection_buffer(N, size_in, res)
2019-01-25 11:39:31 +01:00
use selection_types
implicit none
2019-01-31 11:26:13 +01:00
BEGIN_DOC
! Allocates the memory for a selection buffer.
Develop (#15) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * Add print_ci_vector in tools (#11) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Merge develop-toto and manus (#12) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop toto (#13) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop manus (#14) * modified printing for rpt2 * Comment * Fixed plugins * Scripting for functionals * Documentation * Develop (#10) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * some modifs * modified gfortran_debug.cfg * fixed automatization of functionals * modified e_xc_general.irp.f * minor modifs in ref_bitmask.irp.f * modifying functionals * rs_ks_scf and ks_scf compiles with the automatic handling of functionals * removed prints * fixed configure * fixed the new functionals * Merge toto * modified automatic functionals * Changed python into python2 * from_xyz suppressed * Cleaning repo * Update README.md * Update README.md * Contributors * Update GITHUB.md * bibtex
2019-03-07 16:29:06 +01:00
! The arrays have dimension size_in and the maximum number of elements is N
2019-01-31 11:26:13 +01:00
END_DOC
2019-01-25 11:39:31 +01:00
Develop (#15) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * Add print_ci_vector in tools (#11) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Merge develop-toto and manus (#12) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop toto (#13) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop manus (#14) * modified printing for rpt2 * Comment * Fixed plugins * Scripting for functionals * Documentation * Develop (#10) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * some modifs * modified gfortran_debug.cfg * fixed automatization of functionals * modified e_xc_general.irp.f * minor modifs in ref_bitmask.irp.f * modifying functionals * rs_ks_scf and ks_scf compiles with the automatic handling of functionals * removed prints * fixed configure * fixed the new functionals * Merge toto * modified automatic functionals * Changed python into python2 * from_xyz suppressed * Cleaning repo * Update README.md * Update README.md * Contributors * Update GITHUB.md * bibtex
2019-03-07 16:29:06 +01:00
integer, intent(in) :: N, size_in
2019-01-25 11:39:31 +01:00
type(selection_buffer), intent(out) :: res
integer :: siz
Develop (#15) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * Add print_ci_vector in tools (#11) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Merge develop-toto and manus (#12) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop toto (#13) * Fixed energies of non-expected s2 * Moved diag_algorithm in Davdison * Fixed travis * Added print_ci_vector * Documentation * Cleaned qp_set_mo_class.ml * Removed Core in taskserver * Frozen core for heavy atoms * Improved molden module * In sync with manus * Fixed some of the documentation errors * Develop manus (#14) * modified printing for rpt2 * Comment * Fixed plugins * Scripting for functionals * Documentation * Develop (#10) * fixed laplacian of aos * corrected the laplacians of aos * added dft_one_e * added new feature for new dft functionals * changed the configure to add new functionals * changed the configure * added dft_one_e/README.rst * added README.rst in new_functionals * added source/programmers_guide/new_ks.rst * Thesis Yann * Added gmp installation in configure * improved qp_e_conv_fci * Doc * Typos * Added variance_max * Fixed completion in qp_create * modif TODO * fixed DFT potential for n_states gt 1 * improved pot pbe * trying to improve sr PBE * fixed potential pbe * fixed the vxc smashed for pbe sr and normal * Comments in selection * bug fixed by peter * Fixed bug with zero beta electrons * Update README.rst * Update e_xc_new_func.irp.f * Update links.rst * Update quickstart.rst * Update quickstart.rst * updated cipsi * Fixed energies of non-expected s2 (#9) * Moved diag_algorithm in Davdison * some modifs * modified gfortran_debug.cfg * fixed automatization of functionals * modified e_xc_general.irp.f * minor modifs in ref_bitmask.irp.f * modifying functionals * rs_ks_scf and ks_scf compiles with the automatic handling of functionals * removed prints * fixed configure * fixed the new functionals * Merge toto * modified automatic functionals * Changed python into python2 * from_xyz suppressed * Cleaning repo * Update README.md * Update README.md * Contributors * Update GITHUB.md * bibtex
2019-03-07 16:29:06 +01:00
siz = max(size_in,1)
2019-01-25 11:39:31 +01:00
double precision :: rss
double precision, external :: memory_of_double
rss = memory_of_double(siz)*(N_int*2+1)
call check_mem(rss,irp_here)
allocate(res%det(N_int, 2, siz), res%val(siz))
res%val(:) = 0d0
res%det(:,:,:) = 0_8
res%N = N
res%mini = 0d0
res%cur = 0
end subroutine
subroutine delete_selection_buffer(b)
use selection_types
implicit none
type(selection_buffer), intent(inout) :: b
if (associated(b%det)) then
deallocate(b%det)
endif
if (associated(b%val)) then
deallocate(b%val)
endif
2019-02-04 13:20:24 +01:00
NULLIFY(b%det)
NULLIFY(b%val)
b%cur = 0
b%mini = 0.d0
b%N = 0
2019-01-25 11:39:31 +01:00
end
subroutine add_to_selection_buffer(b, det, val)
use selection_types
implicit none
type(selection_buffer), intent(inout) :: b
integer(bit_kind), intent(in) :: det(N_int, 2)
double precision, intent(in) :: val
integer :: i
if(b%N > 0 .and. val <= b%mini) then
b%cur += 1
b%det(1:N_int,1:2,b%cur) = det(1:N_int,1:2)
b%val(b%cur) = val
if(b%cur == size(b%val)) then
call sort_selection_buffer(b)
2021-12-07 22:53:28 +01:00
b%cur = b%cur-1
2019-01-25 11:39:31 +01:00
end if
end if
end subroutine
subroutine merge_selection_buffers(b1, b2)
use selection_types
implicit none
BEGIN_DOC
! Merges the selection buffers b1 and b2 into b2
END_DOC
type(selection_buffer), intent(inout) :: b1
type(selection_buffer), intent(inout) :: b2
integer(bit_kind), pointer :: detmp(:,:,:)
double precision, pointer :: val(:)
2019-02-04 14:43:30 +01:00
integer :: i, i1, i2, k, nmwen, sze
2019-01-25 11:39:31 +01:00
if (b1%cur == 0) return
do while (b1%val(b1%cur) > b2%mini)
b1%cur = b1%cur-1
if (b1%cur == 0) then
return
endif
enddo
nmwen = min(b1%N, b1%cur+b2%cur)
double precision :: rss
double precision, external :: memory_of_double
2019-02-04 14:43:30 +01:00
sze = max(size(b1%val), size(b2%val))
! rss = memory_of_double(sze) + 2*N_int*memory_of_double(sze)
! call check_mem(rss,irp_here)
2019-02-04 14:43:30 +01:00
allocate(val(sze), detmp(N_int, 2, sze))
2019-01-25 11:39:31 +01:00
i1=1
i2=1
2022-03-10 00:55:23 +01:00
select case (N_int)
BEGIN_TEMPLATE
case $case
do i=1,nmwen
if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then
exit
else if (i1 > b1%cur) then
val(i) = b2%val(i2)
detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2)
detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2)
i2=i2+1
else if (i2 > b2%cur) then
val(i) = b1%val(i1)
detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1)
detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1)
i1=i1+1
2019-01-25 11:39:31 +01:00
else
2022-03-10 00:55:23 +01:00
if (b1%val(i1) <= b2%val(i2)) then
val(i) = b1%val(i1)
detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1)
detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1)
i1=i1+1
else
val(i) = b2%val(i2)
detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2)
detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2)
i2=i2+1
endif
2019-01-25 11:39:31 +01:00
endif
2022-03-10 00:55:23 +01:00
enddo
do i=nmwen+1,b2%N
val(i) = 0.d0
! detmp(1:$N_int,1,i) = 0_bit_kind
! detmp(1:$N_int,2,i) = 0_bit_kind
enddo
SUBST [ case, N_int ]
(1); 1;;
(2); 2;;
(3); 3;;
(4); 4;;
default; N_int;;
END_TEMPLATE
end select
2019-01-25 11:39:31 +01:00
deallocate(b2%det, b2%val)
b2%det => detmp
b2%val => val
b2%mini = min(b2%mini,b2%val(b2%N))
b2%cur = nmwen
end
subroutine sort_selection_buffer(b)
use selection_types
implicit none
type(selection_buffer), intent(inout) :: b
integer, allocatable :: iorder(:)
integer(bit_kind), pointer :: detmp(:,:,:)
integer :: i, nmwen
logical, external :: detEq
if (b%N == 0 .or. b%cur == 0) return
nmwen = min(b%N, b%cur)
double precision :: rss
double precision, external :: memory_of_double, memory_of_int
2021-12-07 22:53:28 +01:00
! rss = memory_of_int(b%cur) + 2*N_int*memory_of_double(size(b%det,3))
! call check_mem(rss,irp_here)
2019-01-25 11:39:31 +01:00
allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)))
do i=1,b%cur
iorder(i) = i
end do
call dsort(b%val, iorder, b%cur)
do i=1, nmwen
detmp(1:N_int,1,i) = b%det(1:N_int,1,iorder(i))
detmp(1:N_int,2,i) = b%det(1:N_int,2,iorder(i))
end do
deallocate(b%det,iorder)
b%det => detmp
b%mini = min(b%mini,b%val(b%N))
b%cur = nmwen
end subroutine
subroutine make_selection_buffer_s2(b)
use selection_types
type(selection_buffer), intent(inout) :: b
integer(bit_kind), allocatable :: o(:,:,:)
double precision, allocatable :: val(:)
integer :: n_d
integer :: i,k,sze,n_alpha,j,n
logical :: dup
! Sort
integer, allocatable :: iorder(:)
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: configuration_search_key
2019-01-25 11:39:31 +01:00
integer(bit_kind), allocatable :: tmp_array(:,:,:)
logical, allocatable :: duplicate(:)
n_d = b%cur
double precision :: rss
double precision, external :: memory_of_double
rss = (4*N_int+4)*memory_of_double(n_d)
call check_mem(rss,irp_here)
allocate(o(N_int,2,n_d), iorder(n_d), duplicate(n_d), bit_tmp(n_d), &
tmp_array(N_int,2,n_d), val(n_d) )
do i=1,n_d
do k=1,N_int
o(k,1,i) = ieor(b%det(k,1,i), b%det(k,2,i))
o(k,2,i) = iand(b%det(k,1,i), b%det(k,2,i))
enddo
iorder(i) = i
bit_tmp(i) = configuration_search_key(o(1,1,i),N_int)
2019-01-25 11:39:31 +01:00
enddo
deallocate(b%det)
call i8sort(bit_tmp,iorder,n_d)
do i=1,n_d
do k=1,N_int
tmp_array(k,1,i) = o(k,1,iorder(i))
tmp_array(k,2,i) = o(k,2,iorder(i))
enddo
val(i) = b%val(iorder(i))
duplicate(i) = .False.
enddo
! Find duplicates
do i=1,n_d-1
if (duplicate(i)) then
cycle
endif
j = i+1
do while (bit_tmp(j)==bit_tmp(i))
if (duplicate(j)) then
j+=1
if (j>n_d) then
exit
endif
cycle
endif
dup = .True.
do k=1,N_int
2021-12-07 22:53:28 +01:00
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) .or. &
(tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
2019-01-25 11:39:31 +01:00
dup = .False.
exit
endif
enddo
if (dup) then
2021-12-07 22:53:28 +01:00
val(i) = min(val(i), val(j))
2019-01-25 11:39:31 +01:00
duplicate(j) = .True.
endif
j+=1
if (j>n_d) then
exit
endif
enddo
enddo
deallocate (b%val)
! Copy filtered result
integer :: n_p
n_p=0
do i=1,n_d
if (duplicate(i)) then
cycle
endif
n_p = n_p + 1
do k=1,N_int
o(k,1,n_p) = tmp_array(k,1,i)
o(k,2,n_p) = tmp_array(k,2,i)
enddo
val(n_p) = val(i)
enddo
! Sort by importance
do i=1,n_p
iorder(i) = i
end do
call dsort(val,iorder,n_p)
do i=1,n_p
do k=1,N_int
tmp_array(k,1,i) = o(k,1,iorder(i))
tmp_array(k,2,i) = o(k,2,iorder(i))
enddo
enddo
do i=1,n_p
do k=1,N_int
o(k,1,i) = tmp_array(k,1,i)
o(k,2,i) = tmp_array(k,2,i)
enddo
enddo
! Create determinants
n_d = 0
do i=1,n_p
call configuration_to_dets_size(o(1,1,i),sze,elec_alpha_num,N_int)
2019-01-25 11:39:31 +01:00
n_d = n_d + sze
if (n_d > b%cur) then
exit
endif
enddo
rss = (4*N_int+2)*memory_of_double(n_d)
call check_mem(rss,irp_here)
allocate(b%det(N_int,2,2*n_d), b%val(2*n_d))
k=1
do i=1,n_p
n=n_d
call configuration_to_dets_size(o(1,1,i),n,elec_alpha_num,N_int)
call configuration_to_dets(o(1,1,i),b%det(1,1,k),n,elec_alpha_num,N_int)
2019-01-25 11:39:31 +01:00
do j=k,k+n-1
b%val(j) = val(i)
enddo
k = k+n
if (k > n_d) exit
enddo
deallocate(o)
b%cur = n_d
b%N = n_d
end
subroutine remove_duplicates_in_selection_buffer(b)
use selection_types
type(selection_buffer), intent(inout) :: b
integer(bit_kind), allocatable :: o(:,:,:)
double precision, allocatable :: val(:)
integer :: n_d
integer :: i,k,sze,n_alpha,j,n
logical :: dup
! Sort
integer, allocatable :: iorder(:)
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: det_search_key
integer(bit_kind), allocatable :: tmp_array(:,:,:)
logical, allocatable :: duplicate(:)
logical :: found_duplicates
double precision :: rss
double precision, external :: memory_of_double
2021-12-07 22:53:28 +01:00
n_d = b%cur
2019-01-25 11:39:31 +01:00
rss = (4*N_int+4)*memory_of_double(n_d)
call check_mem(rss,irp_here)
found_duplicates = .False.
allocate(iorder(n_d), duplicate(n_d), bit_tmp(n_d), &
tmp_array(N_int,2,n_d), val(n_d) )
do i=1,n_d
iorder(i) = i
bit_tmp(i) = det_search_key(b%det(1,1,i),N_int)
enddo
call i8sort(bit_tmp,iorder,n_d)
do i=1,n_d
do k=1,N_int
tmp_array(k,1,i) = b%det(k,1,iorder(i))
tmp_array(k,2,i) = b%det(k,2,iorder(i))
enddo
val(i) = b%val(iorder(i))
duplicate(i) = .False.
enddo
! Find duplicates
do i=1,n_d-1
if (duplicate(i)) then
cycle
endif
j = i+1
do while (bit_tmp(j)==bit_tmp(i))
if (duplicate(j)) then
j+=1
if (j>n_d) then
exit
endif
cycle
endif
dup = .True.
do k=1,N_int
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) &
.or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
dup = .False.
exit
endif
enddo
if (dup) then
duplicate(j) = .True.
found_duplicates = .True.
endif
j+=1
if (j>n_d) then
exit
endif
enddo
enddo
if (found_duplicates) then
! Copy filtered result
integer :: n_p
n_p=0
do i=1,n_d
if (duplicate(i)) then
cycle
endif
n_p = n_p + 1
do k=1,N_int
b%det(k,1,n_p) = tmp_array(k,1,i)
b%det(k,2,n_p) = tmp_array(k,2,i)
enddo
val(n_p) = val(i)
enddo
b%cur=n_p
b%N=n_p
endif
end