mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-09-01 07:43:41 +02:00
Merge branch 'master' of gitlab.com:scemama/qmcchem
This commit is contained in:
commit
557ef562cb
311
src/JASTROW/jastrow_1b.irp.f
Normal file
311
src/JASTROW/jastrow_1b.irp.f
Normal file
@ -0,0 +1,311 @@
|
|||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, jast_1b_value, (elec_num_8) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! 1-body Jastrow
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include '../constants.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: a, c, rij, tmp
|
||||||
|
double precision :: z, mu, mu_pi, zr, mur
|
||||||
|
|
||||||
|
do i = 1, elec_num
|
||||||
|
|
||||||
|
jast_1b_value(i) = 0.d0
|
||||||
|
|
||||||
|
if( jast_1b_type .eq. 1 ) then ! add 1body-Slater Jastrow
|
||||||
|
! J(i) = - \sum_A c_A exp( - alpha_A r_iA )
|
||||||
|
! !DIR$ LOOP COUNT (100)
|
||||||
|
! do j = 1, nucl_num
|
||||||
|
! a = jast_1bslat_expo(j)
|
||||||
|
! c = jast_1bslat_coef(j)
|
||||||
|
! rij = nucl_elec_dist(j,i)
|
||||||
|
! tmp = c * dexp( - a * rij )
|
||||||
|
! jast_1b_value(i) -= tmp
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 2 ) then ! add 1body-Tanh Jastrow
|
||||||
|
! J(i) = - \sum_A tanh(alpha_A r_iA )
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1btanh_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
tmp = dtanh(a*rij)
|
||||||
|
jast_1b_value(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 3 ) then ! add 1body-Simple Jastrow
|
||||||
|
! J(i) = - \sum_A [ (alpha_A r_iA) / (1 + alpha_A r_iA) ]^2
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_pen(j)
|
||||||
|
rij = a * nucl_elec_dist(j,i)
|
||||||
|
tmp = rij / (1.d0 + rij)
|
||||||
|
jast_1b_value(i) -= tmp*tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 4 ) then ! add 1body-RSDFT Jastrow
|
||||||
|
! J(i) = - \sum_A [ -z_A r_iA erfc(mu*r_iA) + z_A exp(-(mu*r_iA)^2)/(mu*sqt_pi) ]
|
||||||
|
! mu = jast_mu_erf
|
||||||
|
mu = mu_erf
|
||||||
|
mu_pi = 1.d0 / ( dsqpi * mu )
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
z = nucl_charge(j)
|
||||||
|
zr = z * rij
|
||||||
|
mur = mu * rij
|
||||||
|
tmp = - zr * ( 1.d0 - derf(mur) ) + z * mu_pi * dexp(-mur*mur)
|
||||||
|
jast_1b_value(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 5 ) then ! add 1body-erf Jastrow
|
||||||
|
! J(i) = - \sum_A erf( alpha_A r_iA )
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1berf_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
tmp = derf(a*rij)
|
||||||
|
jast_1b_value(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 6 ) then ! add 1body-Gauss Jastrow
|
||||||
|
! J(i) = - \sum_A [ 1 - exp( -alpha_A r_iA^2 ) ]
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1bGauss_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
tmp = 1.d0 - dexp(-a*rij*rij)
|
||||||
|
jast_1b_value(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, jast_1b_grad_x, (elec_num_8) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, jast_1b_grad_y, (elec_num_8) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, jast_1b_grad_z, (elec_num_8) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gradient of the Jastrow
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include '../constants.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: a, c, rij, tmp
|
||||||
|
double precision :: z, mu, mur
|
||||||
|
|
||||||
|
do i = 1, elec_num
|
||||||
|
|
||||||
|
jast_1b_grad_x(i) = 0.d0
|
||||||
|
jast_1b_grad_y(i) = 0.d0
|
||||||
|
jast_1b_grad_z(i) = 0.d0
|
||||||
|
|
||||||
|
if( jast_1b_type .eq. 1 ) then ! add 1body-Slater Jastrow
|
||||||
|
! J(i) = - \sum_A c_A exp( - alpha_A r_iA )
|
||||||
|
! !DIR$ LOOP COUNT (100)
|
||||||
|
! do j = 1, nucl_num
|
||||||
|
! a = jast_1bslat_expo(j)
|
||||||
|
! c = jast_1bslat_coef(j)
|
||||||
|
! rij = nucl_elec_dist(j,i)
|
||||||
|
! tmp = c * a * dexp( - a * rij ) / rij
|
||||||
|
! jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
|
||||||
|
! jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
|
||||||
|
! jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 2 ) then ! add 1body-Tanh Jastrow
|
||||||
|
! J(i) = - \sum_A tanh(alpha_A r_iA )
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1btanh_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
c = dtanh(a*rij)
|
||||||
|
tmp = a * ( 1.d0 - c*c ) / rij
|
||||||
|
jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
|
||||||
|
jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
|
||||||
|
jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 3 ) then ! add 1body-Simple Jastrow
|
||||||
|
! J(i) = - \sum_A [ (alpha_A r_iA) / (1 + alpha_A r_iA) ]^2
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_pen(j)
|
||||||
|
rij = a * nucl_elec_dist(j,i)
|
||||||
|
tmp = (a+a)*a / (1.d0+rij*(3.d0+rij*(3.d0+rij)))
|
||||||
|
jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
|
||||||
|
jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
|
||||||
|
jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 4 ) then ! add 1body-RSDFT Jastrow
|
||||||
|
! J(i) = - \sum_A [ -z_A r_iA erfc(mu*r_iA) + z_A exp(-(mu*r_iA)^2)/(mu*sqt_pi) ]
|
||||||
|
! mu = jast_mu_erf
|
||||||
|
mu = mu_erf
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
z = nucl_charge(j)
|
||||||
|
mur = mu * rij
|
||||||
|
tmp = -z * ( 1.d0 - derf(mur) ) / rij
|
||||||
|
jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
|
||||||
|
jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
|
||||||
|
jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 5 ) then ! add 1body-erf Jastrow
|
||||||
|
! J(i) = - \sum_A erf( alpha_A r_iA )
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1berf_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
c = a * rij
|
||||||
|
tmp = 2.d0 * a * dexp(-c*c) / (dsqpi * rij)
|
||||||
|
jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
|
||||||
|
jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
|
||||||
|
jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 6 ) then ! add 1body-Gauss Jastrow
|
||||||
|
! J(i) = - \sum_A [ 1 - exp( -alpha_A r_iA^2 ) ]
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1bGauss_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
tmp = 2.d0 * a * dexp(-a*rij*rij)
|
||||||
|
jast_1b_grad_x(i) -= nucl_elec_dist_vec(1,j,i) * tmp
|
||||||
|
jast_1b_grad_y(i) -= nucl_elec_dist_vec(2,j,i) * tmp
|
||||||
|
jast_1b_grad_z(i) -= nucl_elec_dist_vec(3,j,i) * tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, jast_1b_lapl, (elec_num_8) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! Laplacian of the Jastrow factor
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
include '../constants.F'
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: a, c, rij, tmp
|
||||||
|
double precision :: mu, mu_pi, mur, z
|
||||||
|
|
||||||
|
do i = 1, elec_num
|
||||||
|
|
||||||
|
jast_1b_lapl(i) = 0.d0
|
||||||
|
|
||||||
|
if( jast_1b_type .eq. 1 ) then ! add 1body-Slater Jastrow
|
||||||
|
! J(i) = - \sum_A c_A exp( - alpha_A r_iA )
|
||||||
|
! !DIR$ LOOP COUNT (100)
|
||||||
|
! do j = 1, nucl_num
|
||||||
|
! a = jast_1bslat_expo(j)
|
||||||
|
! c = jast_1bslat_coef(j)
|
||||||
|
! rij = nucl_elec_dist(j,i)
|
||||||
|
! tmp = c * a * dexp(-a*rij) * ( 2.d0/rij - a )
|
||||||
|
! jast_1b_lapl(i) -= tmp
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 2 ) then ! add 1body-Tanh Jastrow
|
||||||
|
! J(i) = - \sum_A tanh(alpha_A r_iA )
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1btanh_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
c = dtanh(a*rij)
|
||||||
|
tmp = 2.d0 * a * ( 1.d0 - c*c ) * ( 1.d0/rij - a*c )
|
||||||
|
jast_1b_lapl(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 3 ) then ! add 1body-Simple Jastrow
|
||||||
|
! J(i) = - \sum_A [ (alpha_A r_iA) / (1 + alpha_A r_iA) ]^2
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_pen(j)
|
||||||
|
rij = a * nucl_elec_dist(j,i)
|
||||||
|
tmp = 6.d0*a*a / (1.d0+rij*(4.d0+rij*(6.d0+rij*(4.d0+rij))))
|
||||||
|
jast_1b_lapl(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 4 ) then ! add 1body-RSDFT Jastrow
|
||||||
|
! J(i) = - \sum_A [ -z_A r_iA erfc(mu*r_iA) + z_A exp(-(mu*r_iA)^2)/(mu*sqt_pi) ]
|
||||||
|
! mu = jast_mu_erf
|
||||||
|
mu = mu_erf
|
||||||
|
mu_pi = mu / dsqpi
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
z = nucl_charge(j)
|
||||||
|
mur = mu * rij
|
||||||
|
tmp = -2.d0*z*(1.d0-derf(mur))/rij + 2.d0*z*mu_pi*dexp(-mur*mur)
|
||||||
|
jast_1b_lapl(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 5 ) then ! add 1body-erf Jastrow
|
||||||
|
! J(i) = - \sum_A erf( alpha_A r_iA )
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1berf_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
c = a * rij
|
||||||
|
tmp = 4.d0 * dexp(-c*c) * (a/rij-a*a*a*rij) / dsqpi
|
||||||
|
jast_1b_lapl(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
elseif( jast_1b_type .eq. 6 ) then ! add 1body-Gauss Jastrow
|
||||||
|
! J(i) = - \sum_A [ 1 - exp( -alpha_A r_iA^2 ) ]
|
||||||
|
!DIR$ LOOP COUNT (100)
|
||||||
|
do j = 1, nucl_num
|
||||||
|
a = jast_1bGauss_pen(j)
|
||||||
|
rij = nucl_elec_dist(j,i)
|
||||||
|
c = a * rij * rij
|
||||||
|
tmp = 2.d0 * a * dexp(-c) * (3.d0-2.d0*a*c)
|
||||||
|
jast_1b_lapl(i) -= tmp
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, jast_1b_grad_sq, (elec_num_8) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! square of the gradient of the 1-body Jastrow
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
|
||||||
|
do i = 1, elec_num
|
||||||
|
jast_1b_grad_sq(i) = jast_1b_grad_x(i) * jast_1b_grad_x(i) &
|
||||||
|
+ jast_1b_grad_y(i) * jast_1b_grad_y(i) &
|
||||||
|
+ jast_1b_grad_z(i) * jast_1b_grad_z(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
Loading…
Reference in New Issue
Block a user