qp_plugins_scemama/devel/qmcchem/qmc_e_curve.irp.f

program e_curve
  use bitmasks
  implicit none
  integer :: i,j,k, nab, m, l
  double precision :: norm 
  integer, allocatable :: iorder(:)
  double precision , allocatable :: norm_sort(:)
  PROVIDE mo_two_e_integrals_in_map mo_one_e_integrals


  if (.not.read_wf) then
    stop 'Please set read_wf to true'
  endif

  PROVIDE psi_bilinear_matrix_values nuclear_repulsion

  if (.True.) then
    print *,  ''
    print *,  'Energy: ', psi_energy(1)+nuclear_repulsion
  endif
  print *,  ''
  print *,  '=============================='
  print *,  'Energies at different cut-offs'
  print *,  '=============================='
  print *,  ''
  print *,  '=============================================================================='

  print '(A8,2X,A8,A8,A8,2X,A12,2X,A10,2X,A12)',  'Thresh.', 'Ndet', 'Na', 'Nb', 'Cost', 'Norm', 'E'
  print *,  '=============================================================================='
  double precision :: thresh
  integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:)
  integer :: na, nb

  nab = n_det_alpha_unique+n_det_beta_unique
  allocate ( norm_sort(0:nab), iorder(0:nab) )
  thresh = 1.d-8

  do while (N_det > 1)
    nab = n_det_alpha_unique+n_det_beta_unique

    norm_sort(0) = 0.d0
    iorder(0) = 0
    do i=1,n_det_alpha_unique
     norm_sort(i) = det_alpha_norm(i)
     iorder(i) = i
    enddo

    do i=1,n_det_beta_unique
     norm_sort(i+n_det_alpha_unique) = det_beta_norm(i)
     iorder(i+n_det_alpha_unique) = -i
    enddo

    call dsort(norm_sort(1),iorder(1),nab)

    na = n_det_alpha_unique
    nb = n_det_beta_unique
    do j=1,nab
      i = iorder(j)
      if ((i<0).and.(nb>1)) then
        nb -= 1
        do k=1,n_det
          if (psi_bilinear_matrix_columns(k) == -i) then
            psi_bilinear_matrix_values(k,1) = 0.d0
          endif
        enddo
      else if ((i>0).and.(na>1)) then
        na -= 1
        do k=1,n_det
          if (psi_bilinear_matrix_rows(k) ==  i) then
            psi_bilinear_matrix_values(k,1) = 0.d0
          endif
        enddo
      endif
      if (thresh < norm_sort(j)) then
        exit
      endif
    enddo

    do k=1,N_states
      psi_coef(1:N_det,k) = psi_bilinear_matrix_values(1:N_det,k)
      call dset_order(psi_coef(1,k),psi_bilinear_matrix_order_reverse,N_det)
    enddo
    TOUCH psi_det psi_coef

    psi_det = psi_det_sorted
    psi_coef = psi_coef_sorted

    do m=1,n_det
     if (psi_coef_sorted(m,1) == 0.d0) exit
    enddo

    N_det = m-1
    TOUCH psi_det psi_coef N_det

    ! Avoid providing psi_energy 
    if (.True.) then
      double precision :: cost0, cost
      cost0 = elec_alpha_num**3 + elec_beta_num**3
      cost = (na-1) * elec_alpha_num**2 + &
             (nb-1) * elec_beta_num**2 + &
              elec_alpha_num**3 + elec_beta_num**3
      cost = cost/cost0

      double precision :: u_dot_u
      norm = dsqrt(u_dot_u(psi_coef(1,1),N_det))
      print '(E9.1,2X,I8,I8,I8,2X,F10.2,2X,F10.8,2X,F15.10)',  thresh, N_det, &
        na, nb, cost,  norm, psi_energy(1) + nuclear_repulsion
      thresh = thresh * dsqrt(10.d0)
    endif
  enddo
  print *,  '=========================================================='

  deallocate (iorder, norm_sort)
end