mirror of
https://gitlab.com/scemama/qp_plugins_scemama.git
synced 2024-11-07 14:43:41 +01:00
77 lines
1.8 KiB
Fortran
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
|
|
|