10
0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 20:34:58 +01:00

Merge dev

This commit is contained in:
Anthony Scemama 2021-01-25 22:51:22 +01:00
commit f58e9c0127
2 changed files with 58 additions and 27 deletions

View File

@ -255,16 +255,13 @@ end
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
dup = dup .and. (tmp_array(k,1,i) == tmp_array(k,1,j)) &
.and. (tmp_array(k,2,i) == tmp_array(k,2,j))
enddo
if (dup) then
duplicate(j) = .True.
endif
j+=1
j = j+1
if (j>N_det) then
exit
endif
@ -336,8 +333,9 @@ BEGIN_PROVIDER [ integer, cfg_seniority_index, (0:elec_num) ]
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
implicit none
BEGIN_DOC
! Returns the index of the configuration for each determinant
END_DOC
integer :: i,j,k,r,l
@ -347,7 +345,8 @@ BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
integer*8, allocatable :: bit_tmp(:)
integer*8, external :: configuration_search_key
allocate(bit_tmp(N_configuration))
allocate(bit_tmp(0:N_configuration))
bit_tmp(0) = 0
do i=1,N_configuration
bit_tmp(i) = configuration_search_key(psi_configuration(1,1,i),N_int)
enddo
@ -362,16 +361,30 @@ BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
key = configuration_search_key(occ,N_int)
! Binary search
l = 0
r = N_configuration+1
j = shiftr(r-l,1)
do while (j>=1)
j = j+l
key2 = configuration_search_key(psi_configuration(1,1,j),N_int)
if (key2 == key) then
if (bit_tmp(j) == key) then
do while (bit_tmp(j) == bit_tmp(j-1))
j = j-1
enddo
do while (bit_tmp(j) == key)
found = .True.
do k=1,N_int
found = found .and. (psi_configuration(k,1,j) == occ(k,1)) &
.and. (psi_configuration(k,2,j) == occ(k,2))
enddo
if (found) then
det_to_configuration(i) = j
exit
else if (key2 > key) then
endif
j = j+1
enddo
if (found) exit
else if (bit_tmp(j) > key) then
r = j
else
l = j
@ -578,16 +591,33 @@ END_PROVIDER
implicit none
BEGIN_DOC
! psi_configuration_to_psi_det_data(k) -> i : i is the index of the determinant in psi_det.
! psi_configuration_to_psi_det_data(k) -> i : i is the index of the
! determinant in psi_det_sorted_bit
!
! psi_configuration_to_psi_det(1:2,k) gives the first and last index of the
! determinants of configuration k in array psi_configuration_to_psi_det_data.
END_DOC
integer :: i
do i=1,N_configuration
integer :: i, k, iorder
integer, allocatable :: confs(:)
allocate (confs(N_det))
do i=1,N_det
psi_configuration_to_psi_det_data(i) = i
confs(i) = det_to_configuration(i)
enddo
call isort(confs, psi_configuration_to_psi_det_data, N_det)
k=1
psi_configuration_to_psi_det(1,1) = 1
do i=2,N_det
if (confs(i) /= confs(i-1)) then
psi_configuration_to_psi_det(2,k) = i-1
k = k+1
psi_configuration_to_psi_det(1,k) = i
endif
enddo
psi_configuration_to_psi_det(2,k) = N_det
END_PROVIDER

View File

@ -112,11 +112,11 @@ subroutine do_single_excitation_cfg(key_in,key_out,i_hole,i_particle,ok)
use bitmasks
implicit none
BEGIN_DOC
! Applies the signle excitation operator to a configuration
! Applies the single excitation operator to a configuration
! If the excitation is possible, ok is True
END_DOC
integer, intent(in) :: i_hole,i_particle
integer(bit_kind), intent(inout) :: key_in(N_int,2)
integer(bit_kind), intent(in) :: key_in(N_int,2)
logical , intent(out) :: ok
integer :: k,j,i
integer(bit_kind) :: mask
@ -219,3 +219,4 @@ subroutine generate_all_singles_cfg(cfg,singles,n_singles,Nint)
enddo
enddo
end