TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-12-22 20:36:01 +01:00
Code Issues Projects Releases Wiki Activity

Avoid FPE in Jastrow GL

Browse Source
This commit is contained in:
Anthony Scemama 2023-08-23 14:24:33 +02:00
parent 2a38543ba0
commit 1f3a08fa30
3 changed files with 42 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
org/qmckl_ao.org
View File

@ -5483,7 +5483,9 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
if (L(3,j) > 1) then if (L(3,j) > 1) then
w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2) w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2)
end if end if
if (w /= 0.d0) then
if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return
endif
end do end do
test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS

16
org/qmckl_distance.org
View File

@ -1504,6 +1504,10 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, &
y = A(2,i) - B(2,j) y = A(2,i) - B(2,j)
z = A(3,i) - B(3,j) z = A(3,i) - B(3,j)
dist = dsqrt(x*x + y*y + z*z) dist = dsqrt(x*x + y*y + z*z)
! Avoid floating-point exception
if (dist == 0.d0) then
dist = 69.d0/rescale_factor_kappa
endif
dist_inv = 1.0d0/dist dist_inv = 1.0d0/dist
rij = dexp(-rescale_factor_kappa * dist) rij = dexp(-rescale_factor_kappa * dist)
C(1,i,j) = x * dist_inv * rij C(1,i,j) = x * dist_inv * rij
@ -1521,6 +1525,10 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, &
y = A(i,2) - B(2,j) y = A(i,2) - B(2,j)
z = A(i,3) - B(3,j) z = A(i,3) - B(3,j)
dist = dsqrt(x*x + y*y + z*z) dist = dsqrt(x*x + y*y + z*z)
! Avoid floating-point exception
if (dist == 0.d0) then
dist = 69.d0/rescale_factor_kappa
endif
dist_inv = 1.0d0/dist dist_inv = 1.0d0/dist
rij = dexp(-rescale_factor_kappa * dist) rij = dexp(-rescale_factor_kappa * dist)
C(1,i,j) = x * dist_inv * rij C(1,i,j) = x * dist_inv * rij
@ -1538,6 +1546,10 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, &
y = A(2,i) - B(j,2) y = A(2,i) - B(j,2)
z = A(3,i) - B(j,3) z = A(3,i) - B(j,3)
dist = dsqrt(x*x + y*y + z*z) dist = dsqrt(x*x + y*y + z*z)
! Avoid floating-point exception
if (dist == 0.d0) then
dist = 69.d0/rescale_factor_kappa
endif
dist_inv = 1.0d0/dist dist_inv = 1.0d0/dist
rij = dexp(-rescale_factor_kappa * dist) rij = dexp(-rescale_factor_kappa * dist)
C(1,i,j) = x * dist_inv * rij C(1,i,j) = x * dist_inv * rij
@ -1555,6 +1567,10 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, &
y = A(i,2) - B(j,2) y = A(i,2) - B(j,2)
z = A(i,3) - B(j,3) z = A(i,3) - B(j,3)
dist = dsqrt(x*x + y*y + z*z) dist = dsqrt(x*x + y*y + z*z)
! Avoid floating-point exception
if (dist == 0.d0) then
dist = 69.d0/rescale_factor_kappa
endif
dist_inv = 1.0d0/dist dist_inv = 1.0d0/dist
rij = dexp(-rescale_factor_kappa * dist) rij = dexp(-rescale_factor_kappa * dist)
C(1,i,j) = x * dist_inv * rij C(1,i,j) = x * dist_inv * rij

11
org/qmckl_jastrow_champ.org
View File

@ -6095,14 +6095,23 @@ integer function qmckl_compute_jastrow_champ_factor_een_rescaled_e_gl_f( &
een_rescaled_e_gl = 0.0d0 een_rescaled_e_gl = 0.0d0
do nw = 1, walk_num do nw = 1, walk_num
do j = 1, elec_num do j = 1, elec_num
do i = 1, elec_num do i = 1, j-1
rij_inv = 1.0d0 / ee_distance(i, j, nw) rij_inv = 1.0d0 / ee_distance(i, j, nw)
do ii = 1, 3 do ii = 1, 3
elec_dist_gl(ii, i, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv elec_dist_gl(ii, i, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv
end do end do
elec_dist_gl(4, i, j) = 2.0d0 * rij_inv elec_dist_gl(4, i, j) = 2.0d0 * rij_inv
end do end do
elec_dist_gl(:, j, j) = 0.0d0 elec_dist_gl(:, j, j) = 0.0d0
do i = j+1, elec_num
rij_inv = 1.0d0 / ee_distance(i, j, nw)
do ii = 1, 3
elec_dist_gl(ii, i, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv
end do
elec_dist_gl(4, i, j) = 2.0d0 * rij_inv
end do
end do end do
! prepare the actual een table ! prepare the actual een table