qp_plugins_scemama/fnmf/fnmf.irp.f

program fnmf
  implicit none
  BEGIN_DOC
! TODO : Put the documentation of the program here
  END_DOC
  read_wf = .True.
  TOUCH read_wf
  call run
end


subroutine run
 implicit none
 integer :: i, n_real
 double precision, allocatable :: beta(:), vr(:,:), vl(:,:)
 double precision, allocatable :: htmp(:,:), stmp(:,:)

 allocate(Htmp(N_det,N_det), Stmp(N_det,N_det))

 htmp(:, :) = H_dmc_mat(1:N_det, 1:N_det)
 stmp(:, :) = S_dmc_mat(1:N_det, 1:N_det)

 htmp(1, 1) = H_dmc_mat(N_det+1, N_det+1)
 stmp(1, 1) = S_dmc_mat(N_det+1, N_det+1)

 htmp(2:N_det, 1) = H_dmc_mat(2:N_det, N_det+1)
 stmp(2:N_det, 1) = S_dmc_mat(2:N_det, N_det+1)

 htmp(1, 2:N_det) = H_dmc_mat(N_det+1, 2:N_det)
 stmp(1, 2:N_det) = S_dmc_mat(N_det+1, 2:N_det)


 allocate(beta(N_det), vr(N_det,N_det), vl(N_det, N_det))

 call lapack_g_non_sym_real(N_det, Htmp, size(Htmp,1), &
  Stmp, size(Stmp,1), beta, n_real, vl, size(vl,1), vr, size(vr,1))


  vl(:,1) = psi_coef(:,1)

  psi_coef(:,1) *= vr(1,1)
  do i=2,N_det
    psi_coef(i,1) += vr(i,1)
  end do
  double precision, external :: dnrm2, ddot
  double precision :: norm

  norm = dnrm2(N_det, psi_coef, 1)
  psi_coef(:,1) *= 1.d0/norm
  SOFT_TOUCH psi_coef

  print *, '-------------------------------------------------'
  print *, ' psi_old  psi_new'
  print *, '-------------------------------------------------'
  do i=1,N_det
    print '(2(E16.8,X))', vl(i,1), psi_coef(i,1) 
  enddo
  print *, '-------------------------------------------------'

  print *,  ''
  print *, 'Overlap        : ', ddot(N_det, psi_coef, 1, vl, 1)
  print *, 'DMC energy     : ', htmp(1,1) + nuclear_repulsion
  print *, 'Updated energy : ', beta(1) + nuclear_repulsion

  print *,  'H'
  do i=1,N_det
    print *,  htmp(i, 1:N_det)
  enddo
  print *,  'S'
  do i=1,N_det
    print *,  stmp(i, 1:N_det)
  enddo
  call save_wavefunction
 
end