Merge dev

src/determinants/configurations.irp.f

@@ -255,16 +255,13 @@ end
     endif
     dup = .True.
     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
     if (dup) then
       duplicate(j) = .True.
     endif
-    j+=1
+    j = j+1
     if (j>N_det) then
       exit
     endif
@@ -315,8 +312,8 @@ end
 END_PROVIDER
 
 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
  ! the requested seniority
  END_DOC
@@ -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 (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
       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
+ integer :: i, k, iorder
-
+ integer, allocatable :: confs(:)
- do i=1,N_configuration
+ 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
 

src/determinants/create_excitations.irp.f

@@ -112,12 +112,12 @@ 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
+  logical , intent(out)          :: ok
   integer                        :: k,j,i
   integer(bit_kind)              :: mask
   integer(bit_kind)              :: key_out(N_int,2)
@@ -219,3 +219,4 @@ subroutine generate_all_singles_cfg(cfg,singles,n_singles,Nint)
     enddo
   enddo
 end
+