Corrected filter_connected_davidson

src/Dets/README.rst

@@ -77,6 +77,12 @@ Documentation
 `key_pattern_not_in_ref <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/connected_to_ref.irp.f#L222>`_
   Min and max values of the integers of the keys of the reference
 
+`det_connections <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/connections.irp.f#L10>`_
+  .br
+
+`n_con_int <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/connections.irp.f#L2>`_
+  Number of integers to represent the connections between determinants
+
 `davidson_converged <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/davidson.irp.f#L383>`_
   True if the Davidson algorithm is converged
 
@@ -228,15 +234,7 @@ Documentation
   idx(0) is the number of determinants that interact with key1
 
 `filter_connected_i_h_psi0_sc2 <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/filter_connected.irp.f#L310>`_
-  standard filter_connected_i_H_psi but returns in addition
+  Undocumented
-  .br
-  the array of the index of the non connected determinants to key1
-  .br
-  in order to know what double excitation can be repeated on key1
-  .br
-  idx_repeat(0) is the number of determinants that can be used
-  .br
-  to repeat the excitations
 
 `get_s2 <http://github.com/LCPQ/quantum_package/tree/master/src/Dets/s2.irp.f#L1>`_
   Returns <S^2>

src/Dets/filter_connected.irp.f

@@ -111,7 +111,7 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
   integer(bit_kind), intent(in)  :: key2(Nint,2)
   integer, intent(out)           :: idx(0:sze)
   
-  integer                        :: i,j,l
+  integer                        :: i,j,k,l
   integer                        :: degree_x2
   integer :: j_int, j_start
   integer*8 :: itmp
@@ -141,68 +141,78 @@ subroutine filter_connected_davidson(key1,key2,Nint,sze,idx)
       enddo
     enddo
     
- !  l=1
- !  !DIR$ LOOP COUNT (1000)
- !  do i=1,sze
- !    degree_x2 =  popcnt(xor( key1(1,1,i), key2(1,1))) +            &
- !        popcnt(xor( key1(2,1,i), key2(2,1))) 
- !    if (degree_x2 < 5) then
- !      if (idx(l) /= i) then
- !      print *,  l, idx(l), i
- !      endif
- !      idx(l) = i
- !      l = l+1
- !    endif
- !  enddo
-    
   else if (Nint==2) then
     
-    !DIR$ LOOP COUNT (1000)
+    
-    do i=1,sze
+    i = idx(0)
-      degree_x2 =  popcnt(xor( key1(1,1,i), key2(1,1))) +            &
+    do j_int=1,N_con_int
-          popcnt(xor( key1(2,1,i), key2(2,1))) +                     &
+      itmp = det_connections(j_int,i)
-          popcnt(xor( key1(1,2,i), key2(1,2))) +                     &
+      do while (itmp /= 0_8)
-          popcnt(xor( key1(2,2,i), key2(2,2)))
+        j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
+        do j = j_start+1, min(j_start+128,i-1)
+          degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) +         &
+              popcnt(xor( key1(2,1,j), key2(2,1))) +                 &
+              popcnt(xor( key1(1,2,j), key2(1,2))) +                 &
+              popcnt(xor( key1(2,2,j), key2(2,2)))
           if (degree_x2 < 5) then
-        idx(l) = i
+            idx(l) = j
             l = l+1
           endif
         enddo
+        itmp = iand(itmp-1_8,itmp)
+      enddo
+    enddo
     
   else if (Nint==3) then
     
     !DIR$ LOOP COUNT (1000)
-    do i=1,sze
+    i = idx(0)
-      degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) +             &
+    do j_int=1,N_con_int
-          popcnt(xor( key1(1,2,i), key2(1,2))) +                     &
+      itmp = det_connections(j_int,i)
-          popcnt(xor( key1(2,1,i), key2(2,1))) +                     &
+      do while (itmp /= 0_8)
-          popcnt(xor( key1(2,2,i), key2(2,2))) +                     &
+        j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
-          popcnt(xor( key1(3,1,i), key2(3,1))) +                     &
+        do j = j_start+1, min(j_start+128,i-1)
-          popcnt(xor( key1(3,2,i), key2(3,2)))
+          degree_x2 = popcnt(xor( key1(1,1,j), key2(1,1))) +         &
+              popcnt(xor( key1(1,2,j), key2(1,2))) +                 &
+              popcnt(xor( key1(2,1,j), key2(2,1))) +                 &
+              popcnt(xor( key1(2,2,j), key2(2,2))) +                 &
+              popcnt(xor( key1(3,1,j), key2(3,1))) +                 &
+              popcnt(xor( key1(3,2,j), key2(3,2)))
           if (degree_x2 < 5) then
-        idx(l) = i
+            idx(l) = j
             l = l+1
           endif
         enddo
+        itmp = iand(itmp-1_8,itmp)
+      enddo
+    enddo
     
   else
     
     !DIR$ LOOP COUNT (1000)
-    do i=1,sze
+    i = idx(0)
+    do j_int=1,N_con_int
+      itmp = det_connections(j_int,i)
+      do while (itmp /= 0_8)
+        j_start = ishft(j_int-1,13) + ishft(trailz(itmp),7)
+        do j = j_start+1, min(j_start+128,i-1)
           degree_x2 = 0
           !DEC$ LOOP COUNT MIN(4)
-      do j=1,Nint
+          do k=1,Nint
-        degree_x2 = degree_x2+ popcnt(xor( key1(j,1,i), key2(j,1))) +&
+            degree_x2 = degree_x2+ popcnt(xor( key1(k,1,j), key2(k,1))) +&
-            popcnt(xor( key1(j,2,i), key2(j,2)))
+                popcnt(xor( key1(k,2,j), key2(k,2)))
             if (degree_x2 > 4) then
               exit
             endif
           enddo
           if (degree_x2 <= 5) then
-        idx(l) = i
+            idx(l) = j
             l = l+1
           endif
         enddo
+        itmp = iand(itmp-1_8,itmp)
+      enddo
+    enddo
 
   endif
   idx(0) = l-1

src/Dets/slater_rules.irp.f

@@ -868,9 +868,11 @@ subroutine H_u_0(v_0,u_0,H_jj,n,keys_tmp,Nint)
         call filter_connected_davidson(keys_tmp,keys_tmp(1,1,i),Nint,i-1,idx)
         do jj=1,idx(0)
           j = idx(jj)
+          if ( (dabs(u_0(j)) > 1.d-7).or.((dabs(u_0(i)) > 1.d-7)) ) then
             call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij)
             vt (i) = vt (i) + hij*u_0(j)
             vt (j) = vt (j) + hij*u_0(i)
+          endif
         enddo
   enddo
   !$OMP END DO