subroutine CISD_SC2(dets_in,u_in,energies,dim_in,sze,N_st,Nint,convergence)
  use bitmasks
  implicit none
  BEGIN_DOC
  ! CISD+SC2 method              :: take off all the disconnected terms of a CISD (selected or not)
  !
  ! dets_in : bitmasks corresponding to determinants
  !
  ! u_in : guess coefficients on the various states. Overwritten
  !   on exit
  !
  ! dim_in : leftmost dimension of u_in
  !
  ! sze : Number of determinants
  !
  ! N_st : Number of eigenstates
  !
  ! Initial guess vectors are not necessarily orthonormal
  END_DOC
  integer, intent(in)            :: dim_in, sze, N_st, Nint
  integer(bit_kind), intent(in)  :: dets_in(Nint,2,sze)
  double precision, intent(inout) :: u_in(dim_in,N_st)
  double precision, intent(out)  :: energies(N_st)
  double precision, intent(in)   :: convergence
  ASSERT (N_st > 0)
  ASSERT (sze > 0)
  ASSERT (Nint > 0)
  ASSERT (Nint == N_int)
  integer                        :: iter
  integer                        :: i,j,k,l,m
  logical                        :: converged
  double precision               :: overlap(N_st,N_st)
  double precision               :: u_dot_v, u_dot_u
  
  integer                        :: degree,N_double,index_hf
  double precision               :: hij_elec, e_corr_double,e_corr,diag_h_mat_elem,inv_c0
  double precision               :: e_corr_double_before,accu,cpu_2,cpu_1
  integer,allocatable            :: degree_exc(:), index_double(:)
  integer                        :: i_ok
  double precision,allocatable   :: e_corr_array(:),H_jj_ref(:),H_jj_dressed(:),hij_double(:)
  double precision, allocatable  :: eigenvectors(:,:), eigenvalues(:),H_matrix_tmp(:,:)
  integer(bit_kind), allocatable :: doubles(:,:,:)
  integer ,parameter             :: sze_max = 1000

  if(sze.le.sze_max)then
   allocate (eigenvectors(size(H_matrix_all_dets,1),sze))
   allocate (H_matrix_tmp(size(H_matrix_all_dets,1),sze))
   allocate (eigenvalues(sze))
   do i = 1, sze
    do j = 1, sze
     H_matrix_tmp(i,j) = H_matrix_all_dets(i,j)
    enddo
   enddo
  endif
  
  allocate (doubles(Nint,2,sze),e_corr_array(sze),H_jj_ref(sze),H_jj_dressed(sze), &
    index_double(sze), degree_exc(sze), hij_double(sze))
  call write_time(output_Dets)
  write(output_Dets,'(A)') ''
  write(output_Dets,'(A)') 'CISD SC2'
  write(output_Dets,'(A)') '========'
  !$OMP PARALLEL DEFAULT(NONE)                                       &
      !$OMP  SHARED(sze,N_st,                                        &
      !$OMP  H_jj_ref,Nint,dets_in,u_in)                             &
      !$OMP  PRIVATE(i)
  
  !$OMP DO SCHEDULE(guided)
  do i=1,sze
    H_jj_ref(i) = diag_h_mat_elem(dets_in(1,1,i),Nint)
  enddo
  !$OMP END DO NOWAIT
  !$OMP END PARALLEL
  
  N_double = 0
  e_corr = 0.d0
  e_corr_double = 0.d0
  do i = 1, sze
    call get_excitation_degree(ref_bitmask,dets_in(1,1,i),degree,Nint)
    degree_exc(i) = degree+1
    if(degree==0)then
      index_hf=i
    else if (degree == 2)then
      N_double += 1
      index_double(N_double) = i
      doubles(:,:,N_double) = dets_in(:,:,i)
      call i_H_j(ref_bitmask,dets_in(1,1,i),Nint,hij_elec)
      hij_double(N_double) = hij_elec
      e_corr_array(N_double) = u_in(i,1)* hij_elec
      e_corr_double += e_corr_array(N_double)
      e_corr += e_corr_array(N_double)
    else if (degree == 1)then
      call i_H_j(ref_bitmask,dets_in(1,1,i),Nint,hij_elec)
      e_corr += u_in(i,1)* hij_elec
    endif
  enddo
  inv_c0 = 1.d0/u_in(index_hf,1)
  do i = 1, N_double
    e_corr_array(i) = e_corr_array(i) * inv_c0
  enddo
  e_corr = e_corr * inv_c0
  e_corr_double = e_corr_double * inv_c0
  converged = .False.
  e_corr_double_before = e_corr_double
  iter = 0
  do while (.not.converged)
    if (abort_here) then
      exit
    endif
    iter +=1
    !$OMP PARALLEL DEFAULT(NONE)                                     &
        !$OMP PRIVATE(i,j,degree,accu)                               &
        !$OMP SHARED(H_jj_dressed,sze,H_jj_ref,index_hf,N_int,N_double,&
        !$OMP  dets_in,doubles,degree_exc,e_corr_array,e_corr_double)
    !$OMP DO SCHEDULE(STATIC)
    do i=1,sze
      H_jj_dressed(i) = H_jj_ref(i)
      if (i==index_hf)cycle
      accu = -e_corr_double
      select case (N_int)
        case (1)
          do j=1,N_double
            degree =                                               &
                popcnt(xor( dets_in(1,1,i),doubles(1,1,j))) +      &
                popcnt(xor( dets_in(1,2,i),doubles(1,2,j)))
            
            if (degree<=ishft(degree_exc(i),1)) then
              accu += e_corr_array(j)
            endif
          enddo
        case (2)
          do j=1,N_double
            degree =                                               &
                popcnt(xor( dets_in(1,1,i),doubles(1,1,j))) +      &
                popcnt(xor( dets_in(1,2,i),doubles(1,2,j))) +      &
                popcnt(xor( dets_in(2,1,i),doubles(2,1,j))) +      &
                popcnt(xor( dets_in(2,2,i),doubles(2,2,j)))
            
            if (degree<=ishft(degree_exc(i),1)) then
              accu += e_corr_array(j)
            endif
          enddo
        case (3)
          do j=1,N_double
            degree =                                               &
                popcnt(xor( dets_in(1,1,i),doubles(1,1,j))) +      &
                popcnt(xor( dets_in(1,2,i),doubles(1,2,j))) +      &
                popcnt(xor( dets_in(2,1,i),doubles(2,1,j))) +      &
                popcnt(xor( dets_in(2,2,i),doubles(2,2,j))) +      &
                popcnt(xor( dets_in(3,1,i),doubles(3,1,j))) +      &
                popcnt(xor( dets_in(3,2,i),doubles(3,2,j)))
            
            if (degree<=ishft(degree_exc(i),1)) then
              accu += e_corr_array(j)
            endif
          enddo
        case default
          do j=1,N_double
            call get_excitation_degree(dets_in(1,1,i),doubles(1,1,j),degree,N_int)
            if (degree<=degree_exc(i)) then
              accu += e_corr_array(j)
            endif
          enddo
      end select
      H_jj_dressed(i) -= accu
    enddo
    !$OMP END DO
    !$OMP END PARALLEL
    
    PROVIDE n_states_diag h_matrix_all_dets
    if(sze>sze_max)then
     call davidson_diag_hjj(dets_in,u_in,H_jj_dressed,energies,dim_in,sze,N_st,Nint,output_Dets)
    else
     do i = 1,sze
      H_matrix_tmp(i,i) = H_jj_dressed(i)
     enddo
     call lapack_diag(eigenvalues,eigenvectors,                       &
         H_matrix_tmp,size(H_matrix_all_dets,1),sze)
     do j=1,min(N_states_diag,sze)
       do i=1,sze
         u_in(i,j) = eigenvectors(i,j)
       enddo
       energies(j) = eigenvalues(j)
     enddo
    endif

    e_corr_double = 0.d0
    inv_c0 = 1.d0/u_in(index_hf,1)
    do i = 1, N_double
      e_corr_array(i) = u_in(index_double(i),1)*inv_c0 * hij_double(i)
      e_corr_double += e_corr_array(i)
    enddo
    write(output_Dets,'(A,I3)') 'SC2 Iteration ', iter
    write(output_Dets,'(A)') '------------------'
    write(output_Dets,'(A)') ''
    write(output_Dets,'(A)') '===== ================'
    write(output_Dets,'(A)') 'State Energy          '
    write(output_Dets,'(A)') '===== ================'
    do i=1,N_st
      write(output_Dets,'(I5,X,F16.10)') i, energies(i)+nuclear_repulsion
    enddo
    write(output_Dets,'(A)') '===== ================'
    write(output_Dets,'(A)') ''
    call write_double(output_Dets,(e_corr_double - e_corr_double_before),&
        'Delta(E_corr)')
    converged =  dabs(e_corr_double - e_corr_double_before) < convergence
    converged = converged .or. abort_here
    if (converged) then
      exit
    endif
    e_corr_double_before = e_corr_double
    
  enddo
  
  call write_time(output_Dets)
  deallocate (doubles,e_corr_array,H_jj_ref,H_jj_dressed, &
    index_double, degree_exc, hij_double)
  
end

subroutine repeat_excitation(key_in,key_1,key_2,i_ok,Nint)
  use bitmasks
  implicit none
  integer(bit_kind), intent(in)  :: key_in(Nint,2),key_1(Nint,2),key_2(Nint,2)
  integer                        :: Nint
  integer,intent(out)            :: i_ok
  integer                        :: ispin,i_hole,k_hole,j_hole,i_particl,k_particl,j_particl,i_trou,degree,exc(0:2,2,2)
  double precision               :: phase
  i_ok = 1
  call get_excitation(key_1,key_2,exc,degree,phase,Nint)
  integer                        :: h1,p1,h2,p2,s1,s2
  if(degree==2)then
    call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2)
    !  first hole
    k_hole = ishft(h1-1,-5)+1
    j_hole = h1-ishft(k_hole-1,5)-1
    if(iand(key_in(k_hole,s1),ibset(0,j_hole)).eq.0)then
      i_ok = 0
      return
    endif
    
    !  second hole
    k_hole = ishft(h2-1,-5)+1
    j_hole = h2-ishft(k_hole-1,5)-1
    if(iand(key_in(k_hole,s2),ibset(0,j_hole)).eq.0)then
      i_ok = 0
      return
    endif
    
    ! first particle
    k_particl  = ishft(p1-1,-5)+1
    j_particl = p1-ishft(k_particl-1,5)-1
    if(iand(key_in(k_particl,s1),ibset(0,j_particl)).ne.0)then
      i_ok = 0
      return
    endif
    
    ! second particle
    k_particl  = ishft(p2-1,-5)+1
    j_particl = p2-ishft(k_particl-1,5)-1
    if(iand(key_in(k_particl,s2),ibset(0,j_particl)).ne.0)then
      i_ok = 0
      return
    endif
    return
  endif
end

