BEGIN_PROVIDER [ integer, i_state ]
 implicit none
 BEGIN_DOC
 ! Current state
 END_DOC
 i_state = 1
END_PROVIDER

BEGIN_PROVIDER [ integer, N_int ]
 implicit none
 BEGIN_DOC
 ! Number of 64-bit integers needed to represent determinants as binary strings
 END_DOC
 call get_spindeterminants_n_int(N_int)
END_PROVIDER

BEGIN_PROVIDER [ integer, bit_kind ]
 implicit none
 BEGIN_DOC
 ! Number of octets per integer storing determinants
 END_DOC
 call get_spindeterminants_bit_kind(bit_kind)
 ASSERT (bit_kind == 8)
END_PROVIDER

BEGIN_PROVIDER [ integer, N_states ]
 implicit none
 BEGIN_DOC
 ! Number of states in EZFIO file
 END_DOC
 call get_spindeterminants_n_states(N_states)
END_PROVIDER

BEGIN_PROVIDER [ integer, det_num_input ]
  implicit none
  BEGIN_DOC
  ! Number of Det_a x Det_b products in input file
  END_DOC
  call get_spindeterminants_n_det(det_num_input)
END_PROVIDER


 BEGIN_PROVIDER [ double precision, det_alpha_norm, (det_alpha_num) ]
&BEGIN_PROVIDER [ double precision, det_beta_norm, (det_beta_num) ]
 implicit none
 BEGIN_DOC
 ! Norm of the alpha and beta spin determinants in the wave function:
 !
 ! ||Da||_i \sum_j C_{ij}**2
 END_DOC

 integer :: i,j,k
 double precision :: f

 det_alpha_norm = 0.d0
 det_beta_norm  = 0.d0
 do k=1,det_num
   i = det_coef_matrix_rows(k)
   j = det_coef_matrix_columns(k)
   f = det_coef_matrix_values(k)*det_coef_matrix_values(k)
   det_alpha_norm(i) += f
   det_beta_norm(j)  += f
 enddo

END_PROVIDER

 BEGIN_PROVIDER [ double precision, det_coef_matrix_values,  (det_num_input) ]
&BEGIN_PROVIDER [ integer,          det_coef_matrix_rows,    (det_num_input) ]
&BEGIN_PROVIDER [ integer,          det_coef_matrix_columns, (det_num_input) ]
  implicit none
  BEGIN_DOC
  ! det_coef_matrix in sparse storage (Coordinate format for sparse BLAS)
  END_DOC
  double precision, allocatable  :: buffer(:,:)
  allocate (buffer(det_num_input,N_states))
  call get_spindeterminants_psi_coef_matrix_rows(det_coef_matrix_rows)
  call get_spindeterminants_psi_coef_matrix_columns(det_coef_matrix_columns)
  call get_spindeterminants_psi_coef_matrix_values(buffer)
  det_coef_matrix_values(:) = buffer(:,i_state)
  deallocate(buffer)
END_PROVIDER

BEGIN_PROVIDER [ double precision, det_coef_matrix_dense, (det_alpha_num, det_beta_num) ]
 implicit none
 BEGIN_DOC
 ! Dense version of det_coef_matrix
 END_DOC
 integer :: i,j,k
 det_coef_matrix_dense = 0.d0
 do k=1,det_num
   i = det_coef_matrix_rows(k)
   j = det_coef_matrix_columns(k)
   det_coef_matrix_dense(i,j) = det_coef_matrix_values(k)
 enddo
END_PROVIDER


BEGIN_PROVIDER [ integer, det_num ]
  implicit none
  BEGIN_DOC
  ! Number of Det_a x Det_b products. The determinant basis set is reduced with
  ! the CI threshold
  END_DOC
  integer                        :: i,j,k,l
  double precision               :: f

  double precision :: d_alpha(det_alpha_num), d_beta (det_beta_num)
  integer :: i_alpha(det_alpha_num), i_beta(det_beta_num)
  integer :: iorder(max(det_alpha_num,det_beta_num))
  double precision :: t, norm

  t = ci_threshold

  ! Compute the norm of the alpha and beta determinants
  d_alpha = 0.d0
  d_beta  = 0.d0
  do k=1,det_num_input
    i = det_coef_matrix_rows(k)
    j = det_coef_matrix_columns(k)
    f = det_coef_matrix_values(k)*det_coef_matrix_values(k)
    d_alpha(i) += f
    d_beta (j) += f
  enddo
  t = min(t, maxval(d_alpha))
  t = min(t, maxval(d_beta))

  ! Reorder alpha determinants
  do i=1,det_alpha_num
    iorder(i) = i
    if (d_alpha(i) < t) then
      i_alpha(i) = det_alpha_num+i
    else
      i_alpha(i) = i
    endif
  enddo
  call isort(i_alpha,iorder,det_alpha_num)

  i=det_alpha_num
  do while (i > 0) 
    if (i_alpha(i) <= det_alpha_num) then
      det_alpha_num = i
      exit
    else
      i = i-1
    endif
  enddo

  do i=1,det_alpha_num
    psi_det_alpha(:,i) = psi_det_alpha(:,iorder(i))
    i_alpha(iorder(i)) = i
  enddo

  ! Reorder beta determinants
  do i=1,det_beta_num
    iorder(i) = i
    if (d_beta(i) < t) then
      i_beta(i) = det_beta_num+i
    else
      i_beta(i) = i
    endif
  enddo
  call isort(i_beta,iorder,det_beta_num)


  i=det_beta_num
  do while (i > 0) 
    if (i_beta(i) <= det_beta_num) then
      det_beta_num = i
      exit
    else
      i = i-1
    endif
  enddo

  do i=1,det_beta_num
    psi_det_beta(:,i) = psi_det_beta(:,iorder(i))
    i_beta(iorder(i)) = i
  enddo

      
  ! Apply the threshold to the wave function
  l = 1
  norm = 0.d0
  do k=1,det_num_input
    i = det_coef_matrix_rows(k)
    j = det_coef_matrix_columns(k)
    det_coef_matrix_rows(l)    = i_alpha(i)
    det_coef_matrix_columns(l) = i_beta(j)
    det_coef_matrix_values(l)  = det_coef_matrix_values(k)
    if ( (d_alpha(i) >= t).and.(d_beta(j) >= t) ) then
      l = l+1
      norm += det_coef_matrix_values(k)*det_coef_matrix_values(k)
    endif
  enddo
  det_num = l-1
  norm = 1.d0/dsqrt(norm)
  do k=1,det_num
    det_coef_matrix_values(k) *= norm
  enddo

  SOFT_TOUCH det_alpha_num det_beta_num det_coef_matrix_values det_coef_matrix_rows det_coef_matrix_columns psi_det_beta psi_det_alpha

END_PROVIDER

 BEGIN_PROVIDER [ integer, det_alpha_num ]
&BEGIN_PROVIDER [ integer, det_beta_num  ]
  implicit none
  BEGIN_DOC
  ! Number of alpha and beta determinants
  END_DOC
  call get_spindeterminants_n_det_alpha(det_alpha_num)
  call get_spindeterminants_n_det_beta(det_beta_num)
END_PROVIDER

 BEGIN_PROVIDER [ integer, det_alpha_num_8 ]
&BEGIN_PROVIDER [ integer, det_beta_num_8  ]
  implicit none
  BEGIN_DOC
  ! Number of alpha and beta determinants
  END_DOC
  integer                        :: mod_align
  det_alpha_num_8 = max(4,mod_align(det_alpha_num)) ! 
  det_beta_num_8  = max(4,mod_align(det_beta_num))  ! Used in 4x unrolling
END_PROVIDER


BEGIN_PROVIDER [ double precision, ci_threshold ]
  
  implicit none
  BEGIN_DOC
  ! Threshold on absolute value of the CI coefficients of the wave functioE
  END_DOC
  ci_threshold = 0.d0
  call get_simulation_ci_threshold(ci_threshold)
  call dinfo(irp_here,'ci_threshold',ci_threshold)
  
END_PROVIDER

BEGIN_PROVIDER [ integer*8, psi_det_alpha, (N_int,det_alpha_num) ]
 implicit none
 BEGIN_DOC
 ! Alpha determinants
 END_DOC
 call get_spindeterminants_psi_det_alpha(psi_det_alpha)
END_PROVIDER

BEGIN_PROVIDER [ integer*8, psi_det_beta, (N_int,det_beta_num) ]
 implicit none
 BEGIN_DOC
 ! Beta determinants
 END_DOC
 call get_spindeterminants_psi_det_beta(psi_det_beta)
END_PROVIDER

BEGIN_PROVIDER  [ integer, present_mos, (mo_tot_num) ]
&BEGIN_PROVIDER [ integer, num_present_mos ]
&BEGIN_PROVIDER [ integer, num_present_mos_8 ]
&BEGIN_PROVIDER [ integer, mo_closed_num ]
  implicit none
  BEGIN_DOC
  ! List of used MOs to build the wf in the CI expansion
  END_DOC
  integer*8                      :: tmp_det(N_int)
  integer                        :: i,k
  integer, external              :: mod_align
  PROVIDE det_num

  num_present_mos = mo_tot_num
  do i=1,mo_tot_num
    present_mos(i) = i
  enddo

!---
  present_mos = 0
  tmp_det = 0_8
  do i=1,det_alpha_num
    do k=1,N_int
      tmp_det(k) = ior(tmp_det(k),psi_det_alpha(k,i))
    enddo
  enddo
  do i=1,det_beta_num
    do k=1,N_int
      tmp_det(k) = ior(tmp_det(k),psi_det_beta(k,i))
    enddo
  enddo
  call bitstring_to_list(tmp_det,present_mos,num_present_mos,N_int)
!---

  num_present_mos_8 = mod_align(num_present_mos)

  integer :: list(mo_tot_num), n
  logical :: good

  list = present_mos
  mo_closed_num = elec_beta_num
  do n=1,elec_beta_num
    call list_to_bitstring(tmp_det,present_mos,n,N_int)
    do k=1,N_int
      if (tmp_det(k) == 0_8) then
        exit
      endif
      good = .True.
      do i=1,det_alpha_num
        if (iand(tmp_det(k),psi_det_alpha(k,i)) /= tmp_det(k)) then
          good = .False.
          exit
        endif
      enddo
      if (good) then
        do i=1,det_beta_num
          if (iand(tmp_det(k),psi_det_beta(k,i)) /= tmp_det(k)) then
            good = .False.
            exit
          endif
        enddo
      endif
      if (.not.good) then
        exit
      endif
    enddo
    if (.not.good) then
      mo_closed_num = n-1
      exit
    endif
  enddo
END_PROVIDER

subroutine list_to_bitstring( string, list, n_elements, Nint)
  implicit none
  BEGIN_DOC
  ! Returns the physical string "string(N_int,2)" from the array of
  ! occupations "list(N_int*64,2)
  END_DOC
  integer, intent(in)            :: Nint
  integer*8, intent(out)         :: string(Nint)
  integer, intent(in)            :: list(Nint*64)
  integer, intent(in)            :: n_elements
  
  
  integer                        :: i, j
  integer                        :: ipos, iint

  ! 
  !                                       <== ipos ==>
  !                                                  |
  !                                                  v
  !string :|------------------------|-------------------------|------------------------|
  !        <====      64       ====> <====      64       ====> <====      64       ====>
  !        {        iint            } {         iint         } {         iint         }
  ! 

  string = 0_8

  do i=1,n_elements
    iint = ishft(list(i)-1,-6) + 1
    ipos = list(i)-ishft((iint-1),6)-1
    string(iint) = ibset( string(iint), ipos )
  enddo

end


BEGIN_PROVIDER [ integer, det_alpha_order, (det_alpha_num) ]
 implicit none
 BEGIN_DOC
 ! Order in which to compute the alhpa determinants
 END_DOC
 integer :: i
! double precision :: tmp(det_alpha_num)
 do i=1,det_alpha_num
   det_alpha_order(i) = i
 enddo
END_PROVIDER

BEGIN_PROVIDER [ integer, det_beta_order, (det_beta_num) ]
 implicit none
 BEGIN_DOC
 ! Order in which to compute the beta determinants
 END_DOC
 integer :: i
 do i=1,det_beta_num
   det_beta_order(i) = i
 enddo
END_PROVIDER