mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-06-14 01:05:18 +02:00
222 lines
6.5 KiB
Fortran
222 lines
6.5 KiB
Fortran
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, ci_overlap_psidet_SVD, (size_ci_overlap_psidet_SVD) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! !!!
|
|
! < psi_0 | det(j) >
|
|
! Dimensions : n_svd_coefs
|
|
END_DOC
|
|
|
|
integer :: k
|
|
do k = 1, n_svd_coefs
|
|
ci_overlap_psidet_SVD(k) = det_alpha_value_SVD(k) * det_beta_value_SVD(k) * psidet_inv_SVD
|
|
enddo
|
|
|
|
ci_overlap_psidet_SVD_min = min(ci_overlap_psidet_SVD_min,minval(ci_overlap_psidet_SVD))
|
|
ci_overlap_psidet_SVD_max = max(ci_overlap_psidet_SVD_max,maxval(ci_overlap_psidet_SVD))
|
|
SOFT_TOUCH ci_overlap_psidet_SVD_min ci_overlap_psidet_SVD_max
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, ci_h_psidet_SVD, (size_ci_h_psidet_SVD) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! !!!
|
|
! < psi_0 |H| det(j) >
|
|
! Dimensions : n_svd_coefs
|
|
END_DOC
|
|
|
|
integer :: k, e
|
|
double precision :: T
|
|
|
|
do k = 1, n_svd_coefs
|
|
T = 0.d0
|
|
do e = 1, elec_alpha_num
|
|
T += det_alpha_grad_lapl_SVD(4,e,k) * det_beta_value_SVD(k)
|
|
enddo
|
|
do e = elec_beta_num+1, elec_num
|
|
T += det_beta_grad_lapl_SVD(4,e,k) * det_alpha_value_SVD(k)
|
|
enddo
|
|
ci_h_psidet_SVD(k) = -0.5d0*T + E_pot * det_alpha_value_SVD(k) * det_beta_value_SVD(k)
|
|
ci_h_psidet_SVD(k) *= psidet_inv_SVD
|
|
enddo
|
|
|
|
ci_h_psidet_SVD_min = min(ci_h_psidet_SVD_min,minval(ci_h_psidet_SVD))
|
|
ci_h_psidet_SVD_max = max(ci_h_psidet_SVD_max,maxval(ci_h_psidet_SVD))
|
|
SOFT_TOUCH ci_h_psidet_SVD_min ci_h_psidet_SVD_max
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, ci_overlap_matrix_SVD, (size_ci_overlap_matrix_SVD) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! !!!
|
|
! < det(i) | det(j) >
|
|
! Dimensions : n_svd_coefs * n_svd_coefs
|
|
END_DOC
|
|
|
|
integer :: k, l
|
|
double precision :: f
|
|
|
|
do k = 1, n_svd_coefs
|
|
f = det_alpha_value_SVD(k) * det_beta_value_SVD(k) * psidet_inv_SVD * psidet_inv_SVD
|
|
do l = 1, n_svd_coefs
|
|
ci_overlap_matrix_SVD( n_svd_coefs*(k-1) + l) = det_alpha_value_SVD(l) * det_beta_value_SVD(l) * f
|
|
enddo
|
|
enddo
|
|
|
|
ci_overlap_matrix_SVD_min = min(ci_overlap_matrix_SVD_min,minval(ci_overlap_matrix_SVD))
|
|
ci_overlap_matrix_SVD_max = max(ci_overlap_matrix_SVD_max,maxval(ci_overlap_matrix_SVD))
|
|
SOFT_TOUCH ci_overlap_matrix_SVD_min ci_overlap_matrix_SVD_max
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, ci_h_matrix_SVD, (size_ci_h_matrix_SVD) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! !!!
|
|
! < det(i) | H | det(j) >
|
|
! Dimensions : n_svd_coefs * n_svd_coefs
|
|
END_DOC
|
|
|
|
integer :: k, l, e
|
|
double precision :: f, g, h, T, V
|
|
|
|
do l = 1, n_svd_coefs
|
|
! Lapl D
|
|
g = 0.d0
|
|
do e = 1, elec_alpha_num
|
|
g += det_alpha_grad_lapl_SVD(4,e,l) * det_beta_value_SVD(l)
|
|
enddo
|
|
do e = elec_alpha_num+1, elec_num
|
|
g += det_alpha_value_SVD(l) * det_beta_grad_lapl_SVD(4,e,l)
|
|
enddo
|
|
T = g
|
|
! D (Lapl J)/J
|
|
g = 0.d0
|
|
do e = 1, elec_num
|
|
g += jast_lapl_jast_inv(e)
|
|
enddo
|
|
T += det_alpha_value_SVD(l) * det_beta_value_SVD(l) * g
|
|
! 2 (grad D).(Grad J)/J
|
|
g = 0.d0
|
|
do e = 1, elec_alpha_num
|
|
g += &
|
|
det_alpha_grad_lapl_SVD(1,e,l) * jast_grad_jast_inv_x(e) + &
|
|
det_alpha_grad_lapl_SVD(2,e,l) * jast_grad_jast_inv_y(e) + &
|
|
det_alpha_grad_lapl_SVD(3,e,l) * jast_grad_jast_inv_z(e)
|
|
enddo
|
|
h = 0.d0
|
|
do e = elec_alpha_num+1, elec_num
|
|
h += &
|
|
det_beta_grad_lapl_SVD(1,e,l) * jast_grad_jast_inv_x(e) + &
|
|
det_beta_grad_lapl_SVD(2,e,l) * jast_grad_jast_inv_y(e) + &
|
|
det_beta_grad_lapl_SVD(3,e,l) * jast_grad_jast_inv_z(e)
|
|
enddo
|
|
T += 2.d0 * ( g * det_beta_value_SVD(l) + h * det_alpha_value_SVD(l) )
|
|
g = det_alpha_value_SVD(l) * det_beta_value_SVD(l)
|
|
V = E_pot * g
|
|
do e = 1, elec_alpha_num
|
|
V -= pseudo_non_local_SVD(e) * g
|
|
V += det_alpha_pseudo_SVD(e,l) * det_beta_value_SVD(l)
|
|
enddo
|
|
do e = elec_alpha_num+1, elec_num
|
|
V -= pseudo_non_local_SVD(e) * g
|
|
V += det_alpha_value_SVD(l) * det_beta_pseudo_SVD(e,l)
|
|
enddo
|
|
f = -0.5d0*T + V
|
|
f *= psidet_inv_SVD * psidet_inv_SVD
|
|
do k = 1, n_svd_coefs
|
|
ci_h_matrix_SVD( n_svd_coefs*(l-1) + k) = f * det_alpha_value_SVD(k) * det_beta_value_SVD(k)
|
|
enddo
|
|
enddo
|
|
|
|
ci_h_matrix_SVD_min = min(ci_h_matrix_SVD_min,minval(ci_h_matrix_SVD))
|
|
ci_h_matrix_SVD_max = max(ci_h_matrix_SVD_max,maxval(ci_h_matrix_SVD))
|
|
SOFT_TOUCH ci_h_matrix_SVD_min ci_h_matrix_SVD_max
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [ double precision, ci_h_matrix_diag_SVD, (size_ci_h_matrix_diag_SVD) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! < det(i) |H| det(j) >
|
|
!
|
|
! Dimensions : n_svd_coefs
|
|
END_DOC
|
|
|
|
integer :: l, e
|
|
double precision :: f, g, h, T, V
|
|
|
|
do l = 1, n_svd_coefs
|
|
! Lapl D
|
|
g = 0.d0
|
|
do e = 1, elec_alpha_num
|
|
g += det_alpha_grad_lapl_SVD(4,e,l) * det_beta_value_SVD(l)
|
|
enddo
|
|
do e = elec_alpha_num+1, elec_num
|
|
g += det_alpha_value_SVD(l) * det_beta_grad_lapl_SVD(4,e,l)
|
|
enddo
|
|
T = g
|
|
! D (Lapl J)/J
|
|
g = 0.d0
|
|
do e = 1, elec_num
|
|
g += jast_lapl_jast_inv(e)
|
|
enddo
|
|
T += det_alpha_value(l) * det_beta_value_SVD(l) * g
|
|
! 2 (grad D).(Grad J)/J
|
|
g = 0.d0
|
|
do e = 1 , elec_alpha_num
|
|
g += &
|
|
det_alpha_grad_lapl_SVD(1,e,l) * jast_grad_jast_inv_x(e) + &
|
|
det_alpha_grad_lapl_SVD(2,e,l) * jast_grad_jast_inv_y(e) + &
|
|
det_alpha_grad_lapl_SVD(3,e,l) * jast_grad_jast_inv_z(e)
|
|
enddo
|
|
h = 0.d0
|
|
do e = elec_alpha_num+1, elec_num
|
|
h += &
|
|
det_beta_grad_lapl_SVD(1,e,l) * jast_grad_jast_inv_x(e) + &
|
|
det_beta_grad_lapl_SVD(2,e,l) * jast_grad_jast_inv_y(e) + &
|
|
det_beta_grad_lapl_SVD(3,e,l) * jast_grad_jast_inv_z(e)
|
|
enddo
|
|
T += 2.d0 * ( g * det_beta_value_SVD(l) + h * det_alpha_value_SVD(l) )
|
|
g = det_alpha_value_SVD(l) * det_beta_value_SVD(l)
|
|
V = E_pot * g
|
|
do e = 1, elec_alpha_num
|
|
V -= pseudo_non_local_SVD(e) * g
|
|
V += det_alpha_pseudo_SVD(e,l) * det_beta_value_SVD(l)
|
|
enddo
|
|
do e = elec_alpha_num+1, elec_num
|
|
V -= pseudo_non_local_SVD(e) * g
|
|
V += det_alpha_value_SVD(l) * det_beta_pseudo_SVD(e,l)
|
|
enddo
|
|
f = -0.5d0*T + V
|
|
f *= psidet_inv_SVD * psidet_inv_SVD
|
|
ci_h_matrix_diag_SVD(l) = f * det_alpha_value_SVD(l) * det_beta_value_SVD(l)
|
|
enddo
|
|
|
|
ci_h_matrix_diag_SVD_min = min(ci_h_matrix_diag_SVD_min,minval(ci_h_matrix_diag_SVD))
|
|
ci_h_matrix_diag_SVD_max = max(ci_h_matrix_diag_SVD_max,maxval(ci_h_matrix_diag_SVD))
|
|
SOFT_TOUCH ci_h_matrix_diag_SVD_min ci_h_matrix_diag_SVD_max
|
|
END_PROVIDER
|
|
|
|
|