quantum_package/plugins/Psiref_CAS/psi_ref.irp.f

use bitmasks

 BEGIN_PROVIDER [ integer(bit_kind), psi_ref, (N_int,2,psi_det_size) ]
&BEGIN_PROVIDER [ double precision, psi_ref_coef,  (psi_det_size,n_states) ]
&BEGIN_PROVIDER [ integer, idx_ref, (psi_det_size) ]
&BEGIN_PROVIDER [ integer, N_det_ref ]
  implicit none
  BEGIN_DOC
  ! CAS wave function, defined from the application of the CAS bitmask on the 
  ! determinants. idx_cas gives the indice of the CAS determinant in psi_det.
  END_DOC
  integer :: i,j,k
  N_det_ref = N_det_cas
  do i=1,N_det_ref
    do k=1,N_int
      psi_ref(k,1,i) = psi_cas(k,1,i)
      psi_ref(k,2,i) = psi_cas(k,2,i)
    enddo
    idx_ref(i) = idx_cas(i)
  enddo
  do k=1,N_states
    do i=1,N_det_ref
      psi_ref_coef(i,k) = psi_cas_coef(i,k)
    enddo
  enddo

END_PROVIDER

BEGIN_PROVIDER [ double precision, psi_ref_coef_inv, (psi_det_size,n_states) ]
 implicit none
 BEGIN_DOC
 ! 1/psi_ref_coef
 END_DOC
 integer :: i, i_state
 do i_state=1,N_states
  do i=1,N_det_ref
    psi_ref_coef_inv(i,i_state) = 1.d0/psi_ref_coef(i,i_state)
  enddo
 enddo

END_PROVIDER


 BEGIN_PROVIDER [ integer(bit_kind), psi_ref_restart, (N_int,2,psi_det_size) ]
&BEGIN_PROVIDER [ double precision, psi_ref_coef_restart,  (psi_det_size,n_states) ]
  implicit none
  BEGIN_DOC
  ! Projection of the CAS wave function on the restart wave function. 
  END_DOC
  integer :: i,j,k
  integer, save                  :: ifirst

  if(ifirst == 0)then
   ifirst = 1
   do i=1,N_det_ref
     do k=1,N_int
       psi_ref_restart(k,1,i) = psi_cas(k,1,i)
       psi_ref_restart(k,2,i) = psi_cas(k,2,i)
     enddo
   enddo
   do k=1,N_states
     do i=1,N_det_ref
       psi_ref_coef_restart(i,k) = psi_cas_coef(i,k)
     enddo
   enddo
  endif

END_PROVIDER


 BEGIN_PROVIDER [double precision, electronic_psi_ref_average_value, (N_states)]
&BEGIN_PROVIDER  [double precision, psi_ref_average_value, (N_states)]
 implicit none
 integer :: i,j
 electronic_psi_ref_average_value = psi_energy
 do i = 1, N_states
  psi_ref_average_value(i) = psi_energy(i) + nuclear_repulsion
 enddo
 double precision :: accu,hij
 accu = 0.d0
 do i = 1, N_det_ref
  do j = 1, N_det_ref
   call i_H_j(psi_ref(1,1,i),psi_ref(1,1,j),N_int,hij)
   accu += psi_ref_coef(i,1) * psi_ref_coef(j,1) * hij
  enddo
 enddo
 electronic_psi_ref_average_value(1) = accu
 psi_ref_average_value(1) = electronic_psi_ref_average_value(1) + nuclear_repulsion

END_PROVIDER
 BEGIN_PROVIDER [double precision, norm_psi_ref, (N_states)]
&BEGIN_PROVIDER [double precision, inv_norm_psi_ref, (N_states)]
  implicit none
  integer :: i,j
  norm_psi_ref = 0.d0
  do j = 1, N_states
   do i = 1, N_det_ref
    norm_psi_ref(j) += psi_ref_coef(i,j) * psi_ref_coef(i,j)
   enddo
   inv_norm_psi_ref(j) = 1.d0/(dsqrt(norm_psi_Ref(j)))
   print *,  inv_norm_psi_ref(j)
  enddo

 END_PROVIDER

 BEGIN_PROVIDER [double precision, psi_ref_coef_interm_norm, (N_det_ref,N_states)]
  implicit none
  integer :: i,j
  do j = 1, N_states
   do i = 1, N_det_ref
    psi_ref_coef_interm_norm(i,j) = inv_norm_psi_ref(j) * psi_ref_coef(i,j)
   enddo
  enddo
 END_PROVIDER

 BEGIN_PROVIDER [double precision, psi_non_ref_coef_interm_norm, (N_det_non_ref,N_states)]
  implicit none
  integer :: i,j
  do j = 1, N_states
   do i = 1, N_det_non_ref
    psi_non_ref_coef_interm_norm(i,j) = psi_non_ref_coef(i,j) * inv_norm_psi_ref(j)
   enddo
  enddo
 END_PROVIDER