qp_plugins_scemama/fnmf/fnmf.irp.f

77 lines
1.8 KiB
Fortran

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