From f06d8dc257a9165ac71d4123f4e6967ca489a7e1 Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Wed, 29 Jul 2015 16:08:28 +0200
Subject: [PATCH] Accelerated get_excitation_degree_vector

---
 plugins/MRCC_Utils_new/mrcc_dress.irp.f |  3 ++-
 src/Determinants/slater_rules.irp.f     | 33 ++++++++++++-------------
 2 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/plugins/MRCC_Utils_new/mrcc_dress.irp.f b/plugins/MRCC_Utils_new/mrcc_dress.irp.f
index 5b98e19b..b9465ee7 100644
--- a/plugins/MRCC_Utils_new/mrcc_dress.irp.f
+++ b/plugins/MRCC_Utils_new/mrcc_dress.irp.f
@@ -51,8 +51,9 @@ subroutine mrcc_dress(ndetref,ndetnonref,nstates,delta_ij_,delta_ii_)
    !$OMP END SINGLE
    !$OMP BARRIER
 
-   !$OMP DO SCHEDULE(guided)
+   !$OMP DO SCHEDULE(dynamic)
    do l = 1, N_det_non_ref
+     print *,  l, '/', N_det_non_ref
      double precision               :: t_il,phase_il,hil
      call i_H_j_phase_out(psi_ref(1,1,i),psi_non_ref(1,1,l),N_int,hil,phase_il,exc,degree)
      t_il = hil * lambda_mrcc(i_state,l)
diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f
index d0157ecc..04fd983e 100644
--- a/src/Determinants/slater_rules.irp.f
+++ b/src/Determinants/slater_rules.irp.f
@@ -970,12 +970,12 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
     
     !DIR$ LOOP COUNT (1000)
     do i=1,sze
-      d = ishft(popcnt(xor( key1(1,1,i), key2(1,1))) +       &
-          popcnt(xor( key1(1,2,i), key2(1,2))),-1)
-      if (d > 2) then
+      d = popcnt(xor( key1(1,1,i), key2(1,1))) +       &
+          popcnt(xor( key1(1,2,i), key2(1,2)))
+      if (d > 4) then
         cycle
       else
-        degree(l) = d
+        degree(l) = ishft(d,-1)
         idx(l) = i
         l = l+1
       endif
@@ -985,14 +985,14 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
     
     !DIR$ LOOP COUNT (1000)
     do i=1,sze
-      d = ishft(popcnt(xor( key1(1,1,i), key2(1,1))) +               &
+      d = popcnt(xor( key1(1,1,i), key2(1,1))) +                     &
           popcnt(xor( key1(1,2,i), key2(1,2))) +                     &
           popcnt(xor( key1(2,1,i), key2(2,1))) +                     &
-          popcnt(xor( key1(2,2,i), key2(2,2))),-1)
-      if (d > 2) then
+          popcnt(xor( key1(2,2,i), key2(2,2)))
+      if (d > 4) then
         cycle
       else
-        degree(l) = d
+        degree(l) = ishft(d,-1)
         idx(l)    = i
         l         = l+1
       endif
@@ -1002,16 +1002,16 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
     
     !DIR$ LOOP COUNT (1000)
     do i=1,sze
-      d = ishft( popcnt(xor( key1(1,1,i), key2(1,1))) +              &
+      d = popcnt(xor( key1(1,1,i), key2(1,1))) +                     &
           popcnt(xor( key1(1,2,i), key2(1,2))) +                     &
           popcnt(xor( key1(2,1,i), key2(2,1))) +                     &
           popcnt(xor( key1(2,2,i), key2(2,2))) +                     &
           popcnt(xor( key1(3,1,i), key2(3,1))) +                     &
-          popcnt(xor( key1(3,2,i), key2(3,2))),-1)
-      if (d > 2) then
+          popcnt(xor( key1(3,2,i), key2(3,2)))
+      if (d > 4) then
         cycle
       else
-        degree(l) = d
+        degree(l) = ishft(d,-1)
         idx(l)    = i
         l         = l+1
       endif
@@ -1024,14 +1024,13 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
       d = 0
       !DEC$ LOOP COUNT MIN(4)
       do l=1,Nint
-        d = d + popcnt(xor( key1(l,1,i), key2(l,1))) +&
-            popcnt(xor( key1(l,2,i), key2(l,2)))
+        d = d + popcnt(xor( key1(l,1,i), key2(l,1)))                 &
+              + popcnt(xor( key1(l,2,i), key2(l,2)))
       enddo
-      d = ishft(d,-1)
-      if (d > 2) then
+      if (d > 4) then
         cycle
       else
-        degree(l) = d
+        degree(l) = ishft(d,-1)
         idx(l)    = i
         l         = l+1
       endif