mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-21 11:03:29 +01:00
Sort CFG by seniority
This commit is contained in:
parent
075933e823
commit
e614511261
@ -286,7 +286,7 @@ end
|
||||
enddo
|
||||
|
||||
!- Check
|
||||
! print *, 'Checking for duplicates in occ pattern'
|
||||
! print *, 'Checking for duplicates in configuration'
|
||||
! do i=1,N_configuration
|
||||
! do j=i+1,N_configuration
|
||||
! duplicate(1) = .True.
|
||||
@ -313,6 +313,29 @@ end
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ integer, cfg_seniority_index, (0:elec_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Returns the index in psi_configuration of the first cfg with
|
||||
! the requested seniority
|
||||
END_DOC
|
||||
integer :: i, k, s, sold
|
||||
cfg_seniority_index(:) = -1
|
||||
sold = -1
|
||||
do i=1,N_configuration
|
||||
s = 0
|
||||
do k=1,N_int
|
||||
if (psi_configuration(k,1,i) == 0_bit_kind) cycle
|
||||
s = s + popcnt(psi_configuration(k,1,i))
|
||||
enddo
|
||||
if (s /= sold) then
|
||||
sold = s
|
||||
cfg_seniority_index(s) = i
|
||||
endif
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
@ -12,17 +12,34 @@ integer*8 function det_search_key(det,Nint)
|
||||
end
|
||||
|
||||
|
||||
integer*8 function configuration_search_key(det,Nint)
|
||||
integer*8 function configuration_search_key(cfg,Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Return an integer*8 corresponding to a determinant index for searching
|
||||
! Returns an integer*8 corresponding to a determinant index for searching.
|
||||
! The left-most 8 bits contain the number of open shells+1. This ensures that the CSF
|
||||
! are packed with the same seniority.
|
||||
END_DOC
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: det(Nint,2)
|
||||
integer :: i
|
||||
integer(bit_kind), intent(in) :: cfg(Nint,2)
|
||||
integer :: i, n_open_shells
|
||||
integer*8 :: mask
|
||||
|
||||
i = shiftr(elec_alpha_num, bit_kind_shift)+1
|
||||
configuration_search_key = int(shiftr(ior(det(i,1),det(i,2)),1)+sum(det),8)
|
||||
configuration_search_key = int(shiftr(ior(cfg(i,1),cfg(i,2)),1)+sum(cfg),8)
|
||||
|
||||
mask = X'00FFFFFFFFFFFFFF'
|
||||
configuration_search_key = iand(mask,configuration_search_key)
|
||||
|
||||
n_open_shells = 1
|
||||
do i=1,Nint
|
||||
if (cfg(i,1) == 0_bit_kind) cycle
|
||||
n_open_shells = n_open_shells + popcnt(cfg(i,1))
|
||||
enddo
|
||||
mask = n_open_shells
|
||||
mask = shiftl(mask,56)
|
||||
configuration_search_key = ior (mask,configuration_search_key)
|
||||
|
||||
end
|
||||
|
||||
|
||||
|
@ -907,6 +907,10 @@ integer function get_task_from_taskserver(zmq_to_qp_run_socket,worker_id,task_id
|
||||
|
||||
message = repeat(' ',512)
|
||||
rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 1024, 0)
|
||||
if (rc <= 0) then
|
||||
print *, rc
|
||||
stop "rc"
|
||||
end if
|
||||
rc = min(1024,rc)
|
||||
read(message(1:rc),*, end=10, err=10) reply
|
||||
if (trim(reply) == 'get_task_reply') then
|
||||
|
Loading…
Reference in New Issue
Block a user