diff --git a/src/determinants/configurations.irp.f b/src/determinants/configurations.irp.f index c703a866..f4c22440 100644 --- a/src/determinants/configurations.irp.f +++ b/src/determinants/configurations.irp.f @@ -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 diff --git a/src/determinants/connected_to_ref.irp.f b/src/determinants/connected_to_ref.irp.f index a174659c..7b8ea3e4 100644 --- a/src/determinants/connected_to_ref.irp.f +++ b/src/determinants/connected_to_ref.irp.f @@ -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 diff --git a/src/zmq/utils.irp.f b/src/zmq/utils.irp.f index 07e3a88f..c050e2cb 100644 --- a/src/zmq/utils.irp.f +++ b/src/zmq/utils.irp.f @@ -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