From 77b5e9968753b0b340ee563ed7ae7cdcd703f250 Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Thu, 15 Sep 2016 22:01:46 +0200
Subject: [PATCH] Corrected memory access in MRCC

---
 plugins/MRCC_Utils/mrcc_utils.irp.f   | 20 ++++++++++++--------
 src/Determinants/diagonalize_CI.irp.f |  2 +-
 src/Determinants/s2.irp.f             |  1 -
 3 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f
index 336b5596..b8ed005d 100644
--- a/plugins/MRCC_Utils/mrcc_utils.irp.f
+++ b/plugins/MRCC_Utils/mrcc_utils.irp.f
@@ -274,11 +274,11 @@ BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ]
   integer                        :: j
   character*(8)                  :: st
   call write_time(output_determinants)
-  do j=1,N_states_diag
+  do j=1,min(N_det,N_states_diag)
     write(st,'(I4)') j
     CI_energy_dressed(j) = CI_electronic_energy_dressed(j) + nuclear_repulsion
-    call write_double(output_determinants,CI_energy(j),'Energy of state '//trim(st))
-    call write_double(output_determinants,CI_eigenvectors_s2(j),'S^2 of state '//trim(st))
+    call write_double(output_determinants,CI_energy_dressed(j),'Energy of state '//trim(st))
+    call write_double(output_determinants,CI_eigenvectors_s2_dressed(j),'S^2 of state '//trim(st))
   enddo
 
 END_PROVIDER
@@ -346,7 +346,9 @@ logical function is_generable(det1, det2, Nint)
   else
     tmp_array = (/s2, p2, s1, p1/)
   end if
-  f = searchExc(pp_exists(1,hh_shortcut(f)), tmp_array, hh_shortcut(f+1)-hh_shortcut(f))
+  if (f /= -1) then
+    f = searchExc(pp_exists(1,hh_shortcut(f)), tmp_array, hh_shortcut(f+1)-hh_shortcut(f))
+  endif
 
   is_generable = (f /= -1) 
 end function
@@ -667,12 +669,13 @@ END_PROVIDER
      N_col = 0
      col_shortcut = 0
      
-     !$OMP PARALLEL DO schedule(static,10) default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int, A_val, A_ind)&
+     !$OMP PARALLEL default(none) shared(psi_non_ref, hh_exists, pp_exists, N_int, A_val, A_ind)&
          !$OMP shared(s, hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, psi_non_ref_sorted_idx, psi_ref, N_det_ref)&
          !$OMP private(lref, pp, II, ok, myMask, myDet, ind, phase, wk)
+      allocate(lref(N_det_non_ref))
+     !$OMP DO schedule(static,10) 
      do hh = 1, hh_shortcut(0)
        do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1
-         allocate(lref(N_det_non_ref))
          lref = 0
          do II = 1, N_det_ref
            call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int)
@@ -701,10 +704,11 @@ END_PROVIDER
              A_ind(wk, pp) = i
            end if
          end do
-         deallocate(lref)
        end do
      end do
-     !$OMP END PARALLEL DO
+     !$OMP END DO
+     deallocate(lref)
+     !$OMP END PARALLEL
      
      AtB = 0d0
      AtA_size = 0
diff --git a/src/Determinants/diagonalize_CI.irp.f b/src/Determinants/diagonalize_CI.irp.f
index 479c91a9..54233fe4 100644
--- a/src/Determinants/diagonalize_CI.irp.f
+++ b/src/Determinants/diagonalize_CI.irp.f
@@ -24,7 +24,7 @@ BEGIN_PROVIDER [ double precision, CI_energy, (N_states_diag) ]
   integer                        :: j
   character*(8)                  :: st
   call write_time(output_determinants)
-  do j=1,N_states_diag
+  do j=1,min(N_det,N_states_diag)
     CI_energy(j) = CI_electronic_energy(j) + nuclear_repulsion
     write(st,'(I4)') j
     call write_double(output_determinants,CI_energy(j),'Energy of state '//trim(st))
diff --git a/src/Determinants/s2.irp.f b/src/Determinants/s2.irp.f
index 2e2741b6..569392ac 100644
--- a/src/Determinants/s2.irp.f
+++ b/src/Determinants/s2.irp.f
@@ -59,7 +59,6 @@ BEGIN_PROVIDER [ double precision, expected_s2]
      double precision :: S
      S = (elec_alpha_num-elec_beta_num)*0.5d0 
      expected_s2 = S * (S+1.d0)
-!     expected_s2 = elec_alpha_num - elec_beta_num + 0.5d0 * ((elec_alpha_num - elec_beta_num)**2*0.5d0 - (elec_alpha_num-elec_beta_num))
    endif
 
 END_PROVIDER