mirror of https://gitlab.com/scemama/qmcchem.git
Still works
This commit is contained in:
Francois Coppens
parent
cf361c396b
commit
9a16fb6003
138
src/det.irp.f
138
src/det.irp.f
|
|
@ -194,14 +194,14 @@ END_PROVIDER
|
|||
endif
|
||||
|
||||
PROVIDE mo_value
|
||||
if (det_i /= det_alpha_order(1) ) then ! alpha determinant order changes
|
||||
if (det_i /= det_alpha_order(1) ) then ! alpha determinant order has changed
|
||||
|
||||
n_to_do = 0
|
||||
do k=1,elec_alpha_num
|
||||
imo = mo_list_alpha_curr(k)
|
||||
do k=1,elec_alpha_num ! run over all alpha electrons
|
||||
imo = mo_list_alpha_curr(k)
|
||||
if ( imo /= mo_list_alpha_prev(k) ) then ! mo for electron k has changed
|
||||
n_to_do += 1
|
||||
to_do(n_to_do) = k
|
||||
n_to_do += 1 ! one more electron to update
|
||||
to_do(n_to_do) = k ! remember which electron to update
|
||||
endif
|
||||
enddo
|
||||
|
||||
|
|
@ -409,8 +409,11 @@ END_PROVIDER
|
|||
|
||||
integer (qmckl_exit_code) :: rc
|
||||
integer (qmckl_context) :: context
|
||||
integer(kind=8) :: ddim, nupdates, updates_index(1)
|
||||
real(c_double) :: updates(elec_beta_num,1), breakdown
|
||||
integer(kind=8) :: ddim, nupdates
|
||||
real(c_double) :: breakdown
|
||||
integer(kind=8), allocatable, dimension(:) :: updates_index
|
||||
real(c_double), allocatable, dimension(:,:) :: updates
|
||||
|
||||
|
||||
if (elec_beta_num == 0) then
|
||||
det_beta_value_curr = 0.d0
|
||||
|
|
@ -426,19 +429,21 @@ END_PROVIDER
|
|||
|
||||
if (det_j /= det_beta_order(1)) then
|
||||
|
||||
n_to_do = 0
|
||||
n_to_do = 0 !! Number of updates to apply
|
||||
do k=mo_closed_num+1,elec_beta_num
|
||||
imo = mo_list_beta_curr(k)
|
||||
imo = mo_list_beta_curr(k) !! current MO
|
||||
if ( imo /= mo_list_beta_prev(k) ) then
|
||||
n_to_do += 1
|
||||
to_do(n_to_do) = k
|
||||
n_to_do += 1 !! One more update to apply
|
||||
to_do(n_to_do) = k !! MO-list number to change
|
||||
endif
|
||||
enddo
|
||||
|
||||
! make swaps and keep 1 update
|
||||
write(*,*) "Value of mo_exc_beta_curr = ", mo_exc_beta_curr
|
||||
if (n_to_do > 1 .and. mo_exc_beta_curr == 1) then
|
||||
|
||||
if (iand(n_to_do+1,1)==1) then
|
||||
write(*,*) "Value of n_to_do+1, iand(n_to_do+1,1)", n_to_do+1, iand(n_to_do+1,1)
|
||||
det_beta_value_curr = -det_beta_value_curr
|
||||
!DIR$ VECTOR ALWAYS
|
||||
!DIR$ VECTOR ALIGNED
|
||||
|
|
@ -500,16 +505,66 @@ END_PROVIDER
|
|||
|
||||
ddet = 0.d0
|
||||
|
||||
if (n_to_do < shiftl(elec_beta_num,1)) then
|
||||
if (n_to_do < shiftl(elec_beta_num,1)) then !! Why compare to double the number of electrons?
|
||||
write(*,*) "Value of elec_beta_num, shiftl(elec_beta_num,1)", elec_beta_num, shiftl(elec_beta_num,1)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
! ddet = det_beta_value_curr ! set ddet to the current value
|
||||
allocate(updates(elec_beta_num, n_to_do), &
|
||||
updates_index(n_to_do))
|
||||
|
||||
! do j = 1, n_to_do ! do for all updates
|
||||
! k = to_do(j) ! find back the electron we need to update
|
||||
! imo = mo_list_beta_curr(k) ! find column/row/MO for electron k
|
||||
! write(*,*) "n_to_do : ", n_to_do
|
||||
! write(*,*) "j, k = to_do(j), imo = mo_list_beta_curr(k) : ", j, k, imo
|
||||
! do i = 1, elec_beta_num ! run over all electrons
|
||||
! updates(i, j) = mo_value(elec_alpha_num + i, imo) - slater_matrix_beta(i, k)
|
||||
! slater_matrix_beta(i, k) = mo_value(elec_alpha_num + i, imo)
|
||||
! end do
|
||||
! end do
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
!! THIS WHOLE WHILE LOOP NEEDS TO BE REPLACED WITH 1 CALL TO QMCKL_SHERMAN_MORRISON_SMWB32S()
|
||||
do while ( n_to_do > 0 )
|
||||
ddet = det_beta_value_curr
|
||||
n_to_do_old = n_to_do
|
||||
n_to_do = 0
|
||||
loopcount = 0
|
||||
do l= 1,n_to_do_old
|
||||
k = to_do(l)
|
||||
imo = mo_list_beta_curr(k)
|
||||
! keep doing this until there are no more updates.
|
||||
! This can take multiple runs over the updates stored in to_do()
|
||||
ddet = det_beta_value_curr ! set ddet to the current value
|
||||
n_to_do_old = n_to_do ! remember how many updates there are
|
||||
n_to_do = 0 ! create a new list of update that need to be applied
|
||||
|
||||
do l=1,n_to_do_old ! first run over all updates
|
||||
k = to_do(l) ! find back the electron we need to update
|
||||
imo = mo_list_beta_curr(k) ! find column/row/MO for electron k
|
||||
|
||||
slater_matrix_beta_inv_det = slater_matrix_beta_inv_det / ddet
|
||||
|
||||
open(unit = 2000, file = "SlaterB_old.dat")
|
||||
|
|
@ -528,14 +583,14 @@ END_PROVIDER
|
|||
close(3000)
|
||||
|
||||
do i = 1,elec_beta_num
|
||||
updates(i,1) = mo_value(elec_alpha_num + i, imo) - slater_matrix_beta(i, imo)
|
||||
slater_matrix_beta(i,imo) = mo_value(elec_alpha_num + i, imo)
|
||||
updates(i,1) = mo_value(elec_alpha_num + i, imo) - slater_matrix_beta(i, k)
|
||||
slater_matrix_beta(i, k) = mo_value(elec_alpha_num + i, imo)
|
||||
end do
|
||||
|
||||
context = qmckl_context_create()
|
||||
ddim = elec_beta_num
|
||||
nupdates = 1
|
||||
updates_index(1) = imo
|
||||
updates_index(1) = k
|
||||
breakdown = 1e-3
|
||||
rc = qmckl_sherman_morrison_splitting(context, &
|
||||
ddim, &
|
||||
|
|
@ -569,7 +624,7 @@ END_PROVIDER
|
|||
det_beta_value_curr = ddet
|
||||
else
|
||||
n_to_do += 1
|
||||
to_do(n_to_do) = k
|
||||
to_do(n_to_do) = k
|
||||
ddet = det_beta_value_curr
|
||||
endif
|
||||
enddo
|
||||
|
|
@ -577,7 +632,42 @@ END_PROVIDER
|
|||
ddet = 0.d0
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
enddo !! all updates have been done
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
endif
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue