mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-22 20:34:58 +01:00
Merge dev
This commit is contained in:
commit
f58e9c0127
@ -55,7 +55,7 @@ subroutine configuration_to_dets(o,d,sze,n_alpha,Nint)
|
|||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Generate all possible determinants for a given configuration
|
! Generate all possible determinants for a given configuration
|
||||||
!
|
!
|
||||||
! Input :
|
! Input :
|
||||||
! o : configuration : (doubly occupied, singly occupied)
|
! o : configuration : (doubly occupied, singly occupied)
|
||||||
! sze : Number of produced determinants, computed by `configuration_to_dets_size`
|
! sze : Number of produced determinants, computed by `configuration_to_dets_size`
|
||||||
@ -63,7 +63,7 @@ subroutine configuration_to_dets(o,d,sze,n_alpha,Nint)
|
|||||||
! Nint : N_int
|
! Nint : N_int
|
||||||
!
|
!
|
||||||
! Output:
|
! Output:
|
||||||
! d : determinants
|
! d : determinants
|
||||||
!
|
!
|
||||||
END_DOC
|
END_DOC
|
||||||
integer ,intent(in) :: Nint
|
integer ,intent(in) :: Nint
|
||||||
@ -255,16 +255,13 @@ end
|
|||||||
endif
|
endif
|
||||||
dup = .True.
|
dup = .True.
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
if ( (tmp_array(k,1,i) /= tmp_array(k,1,j)) &
|
dup = dup .and. (tmp_array(k,1,i) == tmp_array(k,1,j)) &
|
||||||
.or. (tmp_array(k,2,i) /= tmp_array(k,2,j)) ) then
|
.and. (tmp_array(k,2,i) == tmp_array(k,2,j))
|
||||||
dup = .False.
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
enddo
|
enddo
|
||||||
if (dup) then
|
if (dup) then
|
||||||
duplicate(j) = .True.
|
duplicate(j) = .True.
|
||||||
endif
|
endif
|
||||||
j+=1
|
j = j+1
|
||||||
if (j>N_det) then
|
if (j>N_det) then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
@ -315,8 +312,8 @@ end
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, cfg_seniority_index, (0:elec_num) ]
|
BEGIN_PROVIDER [ integer, cfg_seniority_index, (0:elec_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Returns the index in psi_configuration of the first cfg with
|
! Returns the index in psi_configuration of the first cfg with
|
||||||
! the requested seniority
|
! the requested seniority
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -336,8 +333,9 @@ BEGIN_PROVIDER [ integer, cfg_seniority_index, (0:elec_num) ]
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
|
BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
! Returns the index of the configuration for each determinant
|
! Returns the index of the configuration for each determinant
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k,r,l
|
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, allocatable :: bit_tmp(:)
|
||||||
integer*8, external :: configuration_search_key
|
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
|
do i=1,N_configuration
|
||||||
bit_tmp(i) = configuration_search_key(psi_configuration(1,1,i),N_int)
|
bit_tmp(i) = configuration_search_key(psi_configuration(1,1,i),N_int)
|
||||||
enddo
|
enddo
|
||||||
@ -362,16 +361,30 @@ BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
|
|||||||
|
|
||||||
key = configuration_search_key(occ,N_int)
|
key = configuration_search_key(occ,N_int)
|
||||||
|
|
||||||
|
! Binary search
|
||||||
l = 0
|
l = 0
|
||||||
r = N_configuration+1
|
r = N_configuration+1
|
||||||
j = shiftr(r-l,1)
|
j = shiftr(r-l,1)
|
||||||
do while (j>=1)
|
do while (j>=1)
|
||||||
j = j+l
|
j = j+l
|
||||||
key2 = configuration_search_key(psi_configuration(1,1,j),N_int)
|
if (bit_tmp(j) == key) then
|
||||||
if (key2 == key) then
|
do while (bit_tmp(j) == bit_tmp(j-1))
|
||||||
det_to_configuration(i) = j
|
j = j-1
|
||||||
exit
|
enddo
|
||||||
else if (key2 > key) then
|
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
|
||||||
|
endif
|
||||||
|
j = j+1
|
||||||
|
enddo
|
||||||
|
if (found) exit
|
||||||
|
else if (bit_tmp(j) > key) then
|
||||||
r = j
|
r = j
|
||||||
else
|
else
|
||||||
l = j
|
l = j
|
||||||
@ -439,7 +452,7 @@ END_PROVIDER
|
|||||||
&BEGIN_PROVIDER [ integer, psi_configuration_sorted_order_reverse, (N_configuration) ]
|
&BEGIN_PROVIDER [ integer, psi_configuration_sorted_order_reverse, (N_configuration) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Configurations sorted by weight
|
! Configurations sorted by weight
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
integer, allocatable :: iorder(:)
|
integer, allocatable :: iorder(:)
|
||||||
@ -451,8 +464,8 @@ END_PROVIDER
|
|||||||
call dsort(weight_configuration_average_sorted,iorder,N_configuration)
|
call dsort(weight_configuration_average_sorted,iorder,N_configuration)
|
||||||
do i=1,N_configuration
|
do i=1,N_configuration
|
||||||
do j=1,N_int
|
do j=1,N_int
|
||||||
psi_configuration_sorted(j,1,i) = psi_configuration(j,1,iorder(i))
|
psi_configuration_sorted(j,1,i) = psi_configuration(j,1,iorder(i))
|
||||||
psi_configuration_sorted(j,2,i) = psi_configuration(j,2,iorder(i))
|
psi_configuration_sorted(j,2,i) = psi_configuration(j,2,iorder(i))
|
||||||
enddo
|
enddo
|
||||||
psi_configuration_sorted_order(iorder(i)) = i
|
psi_configuration_sorted_order(iorder(i)) = i
|
||||||
psi_configuration_sorted_order_reverse(i) = iorder(i)
|
psi_configuration_sorted_order_reverse(i) = iorder(i)
|
||||||
@ -578,16 +591,33 @@ END_PROVIDER
|
|||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
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
|
! 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.
|
! determinants of configuration k in array psi_configuration_to_psi_det_data.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
integer :: i
|
integer :: i, k, iorder
|
||||||
|
integer, allocatable :: confs(:)
|
||||||
|
allocate (confs(N_det))
|
||||||
|
|
||||||
do i=1,N_configuration
|
do i=1,N_det
|
||||||
|
psi_configuration_to_psi_det_data(i) = i
|
||||||
|
confs(i) = det_to_configuration(i)
|
||||||
enddo
|
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
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -112,12 +112,12 @@ subroutine do_single_excitation_cfg(key_in,key_out,i_hole,i_particle,ok)
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
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
|
! If the excitation is possible, ok is True
|
||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: i_hole,i_particle
|
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
|
logical , intent(out) :: ok
|
||||||
integer :: k,j,i
|
integer :: k,j,i
|
||||||
integer(bit_kind) :: mask
|
integer(bit_kind) :: mask
|
||||||
integer(bit_kind) :: key_out(N_int,2)
|
integer(bit_kind) :: key_out(N_int,2)
|
||||||
@ -219,3 +219,4 @@ subroutine generate_all_singles_cfg(cfg,singles,n_singles,Nint)
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
end
|
end
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user