LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-07-04 18:25:50 +02:00
Code Releases Activity

Merge branch 'dev-stable' of https://github.com/QuantumPackage/qp2 into dev-stable
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
eginer 2023-10-03 20:04:58 +02:00
commit dbd0f16307
2 changed files with 78 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
src/non_h_ints_mu/jast_deriv.irp.f
View File

@ -121,8 +121,11 @@
double precision :: f double precision :: f
f = 1.d0 / dble(elec_num - 1) f = 1.d0 / dble(elec_num - 1)
integer*8 :: n_points, k integer*8 :: n_points, n_points_max, k
n_points = n_points_extra_final_grid * n_points_final_grid integer :: ipoint_block, ipoint_end
n_points_max = n_points_extra_final_grid * n_points_final_grid
n_points = 100_8*n_points_extra_final_grid
double precision, allocatable :: rij(:,:,:) double precision, allocatable :: rij(:,:,:)
allocate( rij(3, 2, n_points) ) allocate( rij(3, 2, n_points) )
@ -131,92 +134,96 @@
integer(qmckl_exit_code) :: rc integer(qmckl_exit_code) :: rc
double precision, allocatable :: gl(:,:,:) double precision, allocatable :: gl(:,:,:)
allocate( gl(2,4,n_points) ) allocate( gl(2,4,n_points) )
k=0 do ipoint_block = 1, n_points_final_grid, 100 ! r1
do ipoint = 1, n_points_final_grid ! r1 ipoint_end = min(n_points_final_grid, ipoint_block+100)
do jpoint = 1, n_points_extra_final_grid ! r2
k=k+1 k=0
rij(1:3, 1, k) = final_grid_points (1:3, ipoint) do ipoint = ipoint_block, ipoint_end
rij(1:3, 2, k) = final_grid_points_extra(1:3, jpoint) do jpoint = 1, n_points_extra_final_grid ! r2
k=k+1
rij(1:3, 1, k) = final_grid_points (1:3, ipoint)
rij(1:3, 2, k) = final_grid_points_extra(1:3, jpoint)
end do
enddo enddo
enddo
rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', n_points, rij, n_points*6_8)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, 'qmckl error in set_electron_coord'
rc = qmckl_check(qmckl_ctx_jastrow, rc)
stop -1
endif
rc = qmckl_set_electron_coord(qmckl_ctx_jastrow, 'N', n_points, rij, n_points*6_8) ! ---
if (rc /= QMCKL_SUCCESS) then ! e-e term
print *, irp_here, 'qmckl error in set_electron_coord'
rc = qmckl_check(qmckl_ctx_jastrow, rc)
stop -1
endif
rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
if (rc /= QMCKL_SUCCESS) then
print *, irp_here, ' qmckl error in fact_ee_gl'
rc = qmckl_check(qmckl_ctx_jastrow, rc)
stop -1
endif
! --- k=0
! e-e term do ipoint = ipoint_block, ipoint_end
do jpoint = 1, n_points_extra_final_grid ! r2
rc = qmckl_get_jastrow_champ_factor_ee_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) k=k+1
if (rc /= QMCKL_SUCCESS) then grad1_u12_num(jpoint,ipoint,1) = gl(1,1,k)
print *, irp_here, ' qmckl error in fact_ee_gl' grad1_u12_num(jpoint,ipoint,2) = gl(1,2,k)
rc = qmckl_check(qmckl_ctx_jastrow, rc) grad1_u12_num(jpoint,ipoint,3) = gl(1,3,k)
stop -1 enddo
endif
k=0
do ipoint = 1, n_points_final_grid ! r1
do jpoint = 1, n_points_extra_final_grid ! r2
k=k+1
grad1_u12_num(jpoint,ipoint,1) = gl(1,1,k)
grad1_u12_num(jpoint,ipoint,2) = gl(1,2,k)
grad1_u12_num(jpoint,ipoint,3) = gl(1,3,k)
enddo enddo
enddo
! --- ! ---
! e-e-n term ! e-e-n term
! rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) ! rc = qmckl_get_jastrow_champ_factor_een_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
! if (rc /= QMCKL_SUCCESS) then ! if (rc /= QMCKL_SUCCESS) then
! print *, irp_here, 'qmckl error in fact_een_gl' ! print *, irp_here, 'qmckl error in fact_een_gl'
! rc = qmckl_check(qmckl_ctx_jastrow, rc) ! rc = qmckl_check(qmckl_ctx_jastrow, rc)
! stop -1 ! stop -1
! endif ! endif
! !
! k=0 ! k=0
! do ipoint = 1, n_points_final_grid ! r1 ! do ipoint = 1, n_points_final_grid ! r1
! do jpoint = 1, n_points_extra_final_grid ! r2 ! do jpoint = 1, n_points_extra_final_grid ! r2
! k=k+1 ! k=k+1
! grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,k) ! grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + gl(1,1,k)
! grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,k) ! grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + gl(1,2,k)
! grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,k) ! grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + gl(1,3,k)
! enddo ! enddo
! enddo ! enddo
! --- ! ---
! e-n term ! e-n term
rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*n_points) rc = qmckl_get_jastrow_champ_factor_en_gl(qmckl_ctx_jastrow, gl, 8_8*n_points)
if (rc /= QMCKL_SUCCESS) then if (rc /= QMCKL_SUCCESS) then
print *, irp_here, 'qmckl error in fact_en_gl' print *, irp_here, 'qmckl error in fact_en_gl'
rc = qmckl_check(qmckl_ctx_jastrow, rc) rc = qmckl_check(qmckl_ctx_jastrow, rc)
stop -1 stop -1
endif endif
k=0 k=0
do ipoint = 1, n_points_final_grid ! r1 do ipoint = ipoint_block, ipoint_end ! r1
do jpoint = 1, n_points_extra_final_grid ! r2 do jpoint = 1, n_points_extra_final_grid ! r2
k = k+1 k = k+1
grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,k) grad1_u12_num(jpoint,ipoint,1) = grad1_u12_num(jpoint,ipoint,1) + f * gl(1,1,k)
grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,k) grad1_u12_num(jpoint,ipoint,2) = grad1_u12_num(jpoint,ipoint,2) + f * gl(1,2,k)
grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,k) grad1_u12_num(jpoint,ipoint,3) = grad1_u12_num(jpoint,ipoint,3) + f * gl(1,3,k)
dx = grad1_u12_num(jpoint,ipoint,1)
dy = grad1_u12_num(jpoint,ipoint,2)
dz = grad1_u12_num(jpoint,ipoint,3)
grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz
enddo
enddo enddo
do jpoint = 1, n_points_extra_final_grid ! r2 enddo !ipoint_block
dx = grad1_u12_num(jpoint,ipoint,1)
dy = grad1_u12_num(jpoint,ipoint,2)
dz = grad1_u12_num(jpoint,ipoint,3)
grad1_u12_squared_num(jpoint,ipoint) = dx*dx + dy*dy + dz*dz
enddo
enddo
deallocate(gl, rij) deallocate(gl, rij)

3
src/non_h_ints_mu/qmckl.irp.f
View File

@ -6,11 +6,10 @@ BEGIN_PROVIDER [ integer*8, qmckl_ctx_jastrow ]
! Context for the QMCKL library ! Context for the QMCKL library
END_DOC END_DOC
integer(qmckl_exit_code) :: rc integer(qmckl_exit_code) :: rc
logical(c_bool) :: c_true = .True.
qmckl_ctx_jastrow = qmckl_context_create() qmckl_ctx_jastrow = qmckl_context_create()
rc = qmckl_set_jastrow_champ_spin_independent(qmckl_ctx_jastrow, c_true) rc = qmckl_set_jastrow_champ_spin_independent(qmckl_ctx_jastrow, 1)
rc = qmckl_check(qmckl_ctx_jastrow, rc) rc = qmckl_check(qmckl_ctx_jastrow, rc)
if (rc /= QMCKL_SUCCESS) stop -1 if (rc /= QMCKL_SUCCESS) stop -1