LCPQ
/
qmcchem
mirror of https://gitlab.com/scemama/qmcchem.git
10
1
Fork 1
Code Releases Activity

Problem fixed. Passing Slater inverse with LDS works.

This commit is contained in:
Francois Coppens 2021-10-28 19:51:18 +02:00
parent c9ce7dc588
commit 6cf69185b0
2 changed files with 65 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
src/det.irp.f
View File

@ -175,7 +175,7 @@ END_PROVIDER
integer :: to_do(elec_alpha_num), n_to_do_old, n_to_do
double precision :: tmp_inv(elec_alpha_num_8)
real :: tmp_det(elec_alpha_num_8)
integer, save :: ifirst, couter=0
integer, save :: ifirst
integer (qmckl_exit_code) :: rc
integer (qmckl_context) :: context
@ -274,20 +274,20 @@ END_PROVIDER
ddet = det_alpha_value_curr ! set ddet to the current value
slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det / ddet
open(unit = 2000, file = "SlaterB_old.dat")
open(unit = 3000, file = "SlaterB_old_inv.dat")
do i=1, elec_alpha_num
do j=1, elec_alpha_num
write(2000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later
write(3000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j)
end do
write(2000,*)
write(3000,*)
end do
flush(2000)
flush(3000)
close(2000)
close(3000)
! open(unit = 2000, file = "SlaterB_old.dat")
! open(unit = 3000, file = "SlaterB_old_inv.dat")
! do i=1, elec_alpha_num
! do j=1, elec_alpha_num
! write(2000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later
! write(3000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j)
! end do
! write(2000,*)
! write(3000,*)
! end do
! flush(2000)
! flush(3000)
! close(2000)
! close(3000)
allocate(updates(elec_alpha_num, n_to_do))
do j = 1, n_to_do ! do for all updates
@ -303,33 +303,34 @@ END_PROVIDER
context = qmckl_context_create()
breakdown = 1e-3
rc = qmckl_sherman_morrison(context, &
rc = qmckl_sherman_morrison_smw32s(context, &
int(elec_alpha_num_8, kind=8), &
int(elec_alpha_num, kind=8), &
int(n_to_do, kind=8), &
updates, &
int(to_do, kind=8), &
breakdown, &
slater_matrix_alpha_inv_det(1:elec_alpha_num, 1:elec_alpha_num), &
slater_matrix_alpha_inv_det, &
ddet)
rc = qmckl_context_destroy(context)
deallocate(updates)
open(unit = 4000, file = "SlaterB.dat")
open(unit = 5000, file = "SlaterB_inv.dat")
do i=1, elec_alpha_num
do j=1, elec_alpha_num
write(4000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later
write(5000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j)
end do
write(4000,*)
write(5000,*)
end do
flush(4000)
flush(5000)
close(4000)
close(5000)
! stop
! open(unit = 4000, file = "SlaterB.dat")
! open(unit = 5000, file = "SlaterB_inv.dat")
! do i=1, elec_alpha_num
! do j=1, elec_alpha_num
! write(4000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later
! write(5000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j)
! end do
! write(4000,*)
! write(5000,*)
! end do
! flush(4000)
! flush(5000)
! close(4000)
! close(5000)
! ! stop
slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det * ddet
det_alpha_value_curr = ddet
endif
@ -491,20 +492,20 @@ END_PROVIDER
ddet = det_beta_value_curr ! set ddet to the current value
slater_matrix_beta_inv_det = slater_matrix_beta_inv_det / ddet
open(unit = 2000, file = "SlaterB_old.dat")
open(unit = 3000, file = "SlaterB_old_inv.dat")
do i=1, elec_beta_num
do j=1, elec_beta_num
write(2000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later
write(3000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j)
end do
write(2000,*)
write(3000,*)
end do
flush(2000)
flush(3000)
close(2000)
close(3000)
! open(unit = 2000, file = "SlaterB_old.dat")
! open(unit = 3000, file = "SlaterB_old_inv.dat")
! do i=1, elec_beta_num
! do j=1, elec_beta_num
! write(2000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later
! write(3000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j)
! end do
! write(2000,*)
! write(3000,*)
! end do
! flush(2000)
! flush(3000)
! close(2000)
! close(3000)
allocate(updates(elec_beta_num, n_to_do))
do j = 1, n_to_do ! do for all updates
@ -520,7 +521,7 @@ END_PROVIDER
context = qmckl_context_create()
breakdown = 1e-3
rc = qmckl_sherman_morrison(context, &
rc = qmckl_sherman_morrison_smw32s(context, &
int(elec_beta_num_8, kind=8), &
int(elec_beta_num, kind=8), &
int(n_to_do, kind=8), &
@ -532,21 +533,22 @@ END_PROVIDER
rc = qmckl_context_destroy(context)
deallocate(updates)
open(unit = 4000, file = "SlaterB.dat")
open(unit = 5000, file = "SlaterB_inv.dat")
do i=1, elec_beta_num
do j=1, elec_beta_num
write(4000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later
write(5000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j)
end do
write(4000,*)
write(5000,*)
end do
flush(4000)
flush(5000)
close(4000)
close(5000)
! stop
! open(unit = 4000, file = "SlaterB.dat")
! open(unit = 5000, file = "SlaterB_inv.dat")
! do i=1, elec_beta_num
! do j=1, elec_beta_num
! write(4000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later
! write(5000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j)
! end do
! write(4000,*)
! write(5000,*)
! end do
! flush(4000)
! flush(5000)
! close(4000)
! close(5000)
! ! stop
slater_matrix_beta_inv_det = slater_matrix_beta_inv_det * ddet
det_beta_value_curr = ddet
endif

2
src/qmckl

@ -1 +1 @@
Subproject commit de39b21511fd698f34ee2ae1b55e8b08c6fad22c
Subproject commit befb90e611b5ab96140497503dcc8ded3119d211