mirror of https://gitlab.com/scemama/qmcchem.git
240 lines
7.0 KiB
Fortran
240 lines
7.0 KiB
Fortran
|
|
BEGIN_PROVIDER [ double precision, emudiff ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! E mu
|
|
END_DOC
|
|
|
|
!emudiff = e_loc - energy_mu * jast_value_inv * jast_value_inv
|
|
emudiff = ( e_loc - energy_mu ) * jast_value_inv * jast_value_inv
|
|
|
|
emudiff_min = min(emudiff_min,emudiff)
|
|
emudiff_max = max(emudiff_max,emudiff)
|
|
SOFT_TOUCH emudiff_min emudiff_max
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, Energy_mu ]
|
|
|
|
BEGIN_DOC
|
|
! E mu = < H_mu \Phi / \Phi >_{\Phi^2}
|
|
END_DOC
|
|
|
|
implicit none
|
|
integer :: i
|
|
|
|
Energy_mu = E_nucl
|
|
!DIR$ VECTOR ALIGNED
|
|
!DIR$ LOOP COUNT(200)
|
|
do i = 1, elec_num
|
|
Energy_mu += E_kin_elec_psidet(i)
|
|
enddo
|
|
Energy_mu += Eff_pot_mu + Eff_pot_deriv_mu + E_nucl_elec - three_body_mu
|
|
|
|
energy_mu_min = min(energy_mu_min,energy_mu)
|
|
energy_mu_max = max(energy_mu_max,energy_mu)
|
|
SOFT_TOUCH energy_mu_min energy_mu_max
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [double precision, E_nucl_elec]
|
|
implicit none
|
|
integer :: i,j
|
|
E_nucl_elec = 0.d0
|
|
do i = 1, elec_num
|
|
! E_nucl_elec += E_pot_elec_one(i) + E_pot_elec_two(i)
|
|
E_nucl_elec += E_pot_elec_one(i)
|
|
enddo
|
|
E_nucl_elec_min = min(E_nucl_elec_min,E_nucl_elec)
|
|
E_nucl_elec_max = max(E_nucl_elec_max,E_nucl_elec)
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [double precision, Eff_pot_mu_elec, (elec_num)]
|
|
&BEGIN_PROVIDER [double precision, Eff_pot_mu_elec_simple, (elec_num)]
|
|
|
|
include '../constants.F'
|
|
|
|
implicit none
|
|
integer :: i,j
|
|
double precision :: rij, mu
|
|
|
|
mu = mu_erf
|
|
! mu = jast_mu_erf
|
|
Eff_pot_mu_elec = 0.d0
|
|
|
|
|
|
! 2body-Jastrow:
|
|
!
|
|
! \Delta_i u_ij + \Delta_j u_ij = 2 [ (1-erf(mu r_ij))/r_ij - mu exp(-(mu r_ij)^2)/sqrt(pi) ]
|
|
!
|
|
! (grad_i u_ij)^2 + (grad_j u_ij)^2 = (1-erf(mu r_ij))^2 / 2
|
|
|
|
do i = 1, elec_num
|
|
!DIR$ VECTOR ALIGNED
|
|
!DIR$ LOOP COUNT(50)
|
|
do j = 1, elec_num
|
|
rij = elec_dist(j,i)
|
|
if(i==j)cycle
|
|
|
|
Eff_pot_mu_elec(i) = Eff_pot_mu_elec(i) + 0.5d0 * derf(mu * rij) * elec_dist_inv(j,i)
|
|
Eff_pot_mu_elec(i) = Eff_pot_mu_elec(i) + 0.5d0 * mu/dsqpi * dexp(-mu*mu*rij*rij)
|
|
Eff_pot_mu_elec_simple(i) = Eff_pot_mu_elec(i)
|
|
|
|
Eff_pot_mu_elec(i) = Eff_pot_mu_elec(i) + 0.5d0 * (- 0.25d0 * (1.d0 - derf(mu*rij))**2.d0 )
|
|
|
|
enddo
|
|
enddo
|
|
|
|
! 1-body Jastrow
|
|
! if( jast_1b_type .gt. 0 ) then
|
|
! do i = 1, elec_num
|
|
! Eff_pot_mu_elec(i) -= 0.5d0 * jast_1b_lapl(i)
|
|
! Eff_pot_mu_elec(i) -= 0.5d0 * jast_1b_grad_sq(i)
|
|
! do j = 1, elec_num
|
|
! if(i==j) cycle
|
|
! Eff_pot_mu_elec(i) -= ( jast_elec_Mu_grad_x(i) * ( jast_1b_grad_x(i) - jast_1b_grad_x(j) ) &
|
|
! + jast_elec_Mu_grad_y(i) * ( jast_1b_grad_y(i) - jast_1b_grad_y(j) ) &
|
|
! + jast_elec_Mu_grad_z(i) * ( jast_1b_grad_z(i) - jast_1b_grad_z(j) ) )
|
|
! enddo
|
|
! enddo
|
|
! endif
|
|
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [double precision, Eff_pot_mu ]
|
|
implicit none
|
|
include '../constants.F'
|
|
integer :: i
|
|
Eff_pot_mu = 0.d0
|
|
do i=1,elec_num
|
|
Eff_pot_mu += Eff_pot_mu_elec(i)
|
|
enddo
|
|
Eff_pot_mu_min = min(Eff_pot_mu_min,Eff_pot_mu)
|
|
Eff_pot_mu_max = max(Eff_pot_mu_max,Eff_pot_mu)
|
|
SOFT_TOUCH Eff_pot_mu_min Eff_pot_mu_max
|
|
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [double precision, Eff_pot_mu_simple ]
|
|
implicit none
|
|
include '../constants.F'
|
|
integer :: i
|
|
Eff_pot_mu_simple = 0.d0
|
|
do i=1,elec_num
|
|
Eff_pot_mu_simple += Eff_pot_mu_elec_simple(i)
|
|
enddo
|
|
Eff_pot_mu_simple_min = min(Eff_pot_mu_simple_min,Eff_pot_mu_simple)
|
|
Eff_pot_mu_simple_max = max(Eff_pot_mu_simple_max,Eff_pot_mu_simple)
|
|
SOFT_TOUCH Eff_pot_mu_simple_min Eff_pot_mu_simple_max
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
|
|
BEGIN_PROVIDER [double precision, Eff_pot_deriv_mu_elec, (elec_num) ]
|
|
|
|
BEGIN_DOC
|
|
!
|
|
! non-Hermitian term:
|
|
! - grad_i(tau) . grad_i(\Phi) / \Phi
|
|
!
|
|
END_DOC
|
|
|
|
implicit none
|
|
integer :: i, j
|
|
double precision :: rij, mu
|
|
|
|
! mu = jast_mu_erf
|
|
mu = mu_erf
|
|
Eff_pot_deriv_mu_elec = 0.d0
|
|
|
|
! 2body-Jastrow: (eq A4)
|
|
! - [ grad_i(tau_mu) . grad_i(\Phi) + grad_j(tau_mu) . grad_j(\Phi) ] / \Phi =
|
|
! ( erf(mu r_ij) - 1 ) / ( 2 r_ij \Phi) * [
|
|
! ( x_i - x_j ) * ( \partial_{x_i} - \partial_{x_j} ) +
|
|
! ( y_i - y_j ) * ( \partial_{y_i} - \partial_{y_j} ) +
|
|
! ( z_i - z_j ) * ( \partial_{z_i} - \partial_{z_j} ) ]
|
|
!
|
|
do i = 1, elec_num
|
|
do j = 1, elec_num
|
|
if(i==j)cycle
|
|
rij = elec_dist(i,j)
|
|
Eff_pot_deriv_mu_elec(i) += 0.5d0 * ( derf(mu * rij) - 1.d0 ) * elec_dist_inv(j,i) &
|
|
* ( - elec_dist_vec_x(j,i) * psidet_grad_lapl(1,i) &
|
|
- elec_dist_vec_y(j,i) * psidet_grad_lapl(2,i) &
|
|
- elec_dist_vec_z(j,i) * psidet_grad_lapl(3,i) ) * psidet_inv
|
|
enddo
|
|
enddo
|
|
|
|
|
|
! 1-body Jastrow
|
|
if( jast_1b_type .gt. 0 ) then
|
|
do i = 1, elec_num
|
|
Eff_pot_deriv_mu_elec(i) -= ( jast_1b_grad_x(i) * psidet_grad_lapl(1,i) &
|
|
+ jast_1b_grad_y(i) * psidet_grad_lapl(2,i) &
|
|
+ jast_1b_grad_z(i) * psidet_grad_lapl(3,i) ) * psidet_inv
|
|
enddo
|
|
endif
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [double precision, three_body_mu ]
|
|
implicit none
|
|
integer :: i,j,k
|
|
three_body_mu = 0.d0
|
|
do i = 1, elec_num
|
|
do j = i+1, elec_num
|
|
do k = j+1, elec_num
|
|
three_body_mu += grad_j_mu_x(i,j) * grad_j_mu_x(i,k)
|
|
three_body_mu += grad_j_mu_y(i,j) * grad_j_mu_y(i,k)
|
|
three_body_mu += grad_j_mu_z(i,j) * grad_j_mu_z(i,k)
|
|
|
|
three_body_mu += grad_j_mu_x(j,i) * grad_j_mu_x(j,k)
|
|
three_body_mu += grad_j_mu_y(j,i) * grad_j_mu_y(j,k)
|
|
three_body_mu += grad_j_mu_z(j,i) * grad_j_mu_z(j,k)
|
|
|
|
three_body_mu += grad_j_mu_x(k,i) * grad_j_mu_x(k,j)
|
|
three_body_mu += grad_j_mu_y(k,i) * grad_j_mu_y(k,j)
|
|
three_body_mu += grad_j_mu_z(k,i) * grad_j_mu_z(k,j)
|
|
enddo
|
|
enddo
|
|
enddo
|
|
three_body_mu_min = min(three_body_mu_min,three_body_mu)
|
|
three_body_mu_max = max(three_body_mu_max,three_body_mu)
|
|
SOFT_TOUCH three_body_mu_min three_body_mu_max
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [double precision, Eff_pot_deriv_mu]
|
|
implicit none
|
|
integer :: i
|
|
Eff_pot_deriv_mu = 0.d0
|
|
do i = 1, elec_num
|
|
Eff_pot_deriv_mu += Eff_pot_deriv_mu_elec(i)
|
|
enddo
|
|
eff_pot_deriv_mu_min = min(eff_pot_deriv_mu_min,eff_pot_deriv_mu)
|
|
eff_pot_deriv_mu_max = max(eff_pot_deriv_mu_max,eff_pot_deriv_mu)
|
|
SOFT_TOUCH eff_pot_deriv_mu_min eff_pot_deriv_mu_max
|
|
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ double precision, ci_dress_mu, (size_ci_dress_mu) ]
|
|
BEGIN_DOC
|
|
! Dimensions : det_num
|
|
END_DOC
|
|
implicit none
|
|
integer :: i, j, k, l
|
|
double precision :: T, dij, f, E_noJ, dE
|
|
! energy_mu = H_mu \Phi / \Phi
|
|
dE = (E_loc - energy_mu) * psi_value_inv * jast_value_inv
|
|
do k = 1, det_num
|
|
i = det_coef_matrix_rows( k)
|
|
j = det_coef_matrix_columns(k)
|
|
f = det_alpha_value(i) * det_beta_value(j)
|
|
ci_dress_mu(k) = dE * f
|
|
enddo
|
|
ci_dress_mu_min = min(ci_dress_mu_min, minval(ci_dress_mu))
|
|
ci_dress_mu_max = max(ci_dress_mu_max, maxval(ci_dress_mu))
|
|
SOFT_TOUCH ci_dress_mu_min ci_dress_mu_max
|
|
END_PROVIDER
|
|
|