mirror of https://gitlab.com/scemama/qmcchem.git
Added LDS passing but no longer working. Passed one-time test in Ocrtave but SEGFAULTS when run continuesly.
This commit is contained in:
parent
49b4dece2e
commit
4b4dd1f21c
|
@ -3,15 +3,15 @@
|
|||
## ALIGNMENT
|
||||
|
||||
#CPU_TYPE="-xCORE-AVX2" # [ Host | CORE-AVX2 | CORE-AVX-I | AVX | SSE4.2 ]
|
||||
CPU_TYPE="-xHost"
|
||||
CPU_TYPE="-xCORE-AVX2"
|
||||
|
||||
# Array alignment (Bytes)
|
||||
ALIGN="32"
|
||||
|
||||
## FORTRAN compiler
|
||||
FC="ifort"
|
||||
FC="/opt/intel/oneapi/compiler/2021.3.0/linux/bin/intel64/ifort"
|
||||
FCFLAGS="-O2 -g -ip -ftz -finline ${CPU_TYPE} -qopenmp-simd" #-traceback
|
||||
LIB="-mkl=sequential"
|
||||
LIB="-mkl=sequential -lqmckl"
|
||||
|
||||
## IRPF90
|
||||
IRPF90="${QMCCHEM_PATH}/bin/irpf90"
|
||||
|
|
390
src/det.irp.f
390
src/det.irp.f
|
@ -175,16 +175,14 @@ 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
|
||||
logical :: file_exists
|
||||
integer, save :: ifirst, couter=0
|
||||
|
||||
integer (qmckl_exit_code) :: rc
|
||||
integer (qmckl_context) :: context
|
||||
integer(kind=8) :: ddim, nupdates
|
||||
integer(kind=8) :: nupdates
|
||||
real(c_double) :: breakdown
|
||||
real(c_double), allocatable :: updates(:,:)
|
||||
|
||||
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: tmp_inv, tmp_det
|
||||
|
||||
if (ifirst == 0) then
|
||||
|
@ -200,10 +198,10 @@ END_PROVIDER
|
|||
|
||||
n_to_do = 0
|
||||
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 ! one more electron to update
|
||||
to_do(n_to_do) = k ! remember which electron to update
|
||||
imo = mo_list_alpha_curr(k) ! pick MO-number from list of alpha-MOs
|
||||
if ( imo /= mo_list_alpha_prev(k) ) then ! check if MO-number of kth alpha electron has changed
|
||||
n_to_do += 1 ! update MO of kth alpha electron
|
||||
to_do(n_to_do) = k ! remember which electrons to update
|
||||
endif
|
||||
enddo
|
||||
|
||||
|
@ -273,151 +271,70 @@ END_PROVIDER
|
|||
ddet = 0.d0
|
||||
|
||||
if (n_to_do < shiftl(elec_alpha_num,1)) then
|
||||
ddet = det_alpha_value_curr ! set ddet to the current value
|
||||
slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det / ddet
|
||||
|
||||
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)
|
||||
|
||||
allocate(updates(elec_alpha_num, 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_alpha_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_alpha_curr(k) : ", j, k, imo
|
||||
do i = 1, elec_alpha_num ! run over all electrons
|
||||
updates(i, j) = mo_value(i, imo) - slater_matrix_alpha(i, k)
|
||||
slater_matrix_alpha(i, k) = mo_value(i, imo)
|
||||
end do
|
||||
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)
|
||||
|
||||
context = qmckl_context_create()
|
||||
breakdown = 1e-3
|
||||
rc = qmckl_sherman_morrison_smw32s(context, &
|
||||
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), &
|
||||
ddet)
|
||||
rc = qmckl_context_destroy(context)
|
||||
allocate(updates(elec_alpha_num, 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_alpha_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_alpha_curr(k) : ", j, k, imo
|
||||
do i = 1, elec_alpha_num ! run over all electrons
|
||||
updates(i, j) = mo_value(i, imo) - slater_matrix_alpha(i, k)
|
||||
slater_matrix_alpha(i, k) = mo_value(i, imo)
|
||||
end do
|
||||
end do
|
||||
|
||||
context = qmckl_context_create()
|
||||
breakdown = 1e-3
|
||||
rc = qmckl_sherman_morrison(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), &
|
||||
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)
|
||||
|
||||
slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det * ddet
|
||||
det_alpha_value_curr = ddet
|
||||
deallocate(updates)
|
||||
|
||||
|
||||
! do while ( n_to_do > 0 )
|
||||
! ddet = det_alpha_value_curr ! remember value of det_alpha_value_curr
|
||||
! n_to_do_old = n_to_do ! remember n_to_do value
|
||||
! n_to_do = 0
|
||||
! do l=1,n_to_do_old
|
||||
! k = to_do(l) ! select electron to change
|
||||
! imo = mo_list_alpha_curr(k) ! select mo to change
|
||||
|
||||
! slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det / ddet
|
||||
|
||||
! open(unit = 2000, file = "SlaterA_old.dat")
|
||||
! open(unit = 3000, file = "SlaterA_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)
|
||||
|
||||
! do i = 1,elec_alpha_num
|
||||
! updates(i,1) = mo_value(i, imo) - slater_matrix_alpha(i, imo)
|
||||
! slater_matrix_alpha(i,imo) = mo_value(i, imo)
|
||||
! end do
|
||||
|
||||
! context = qmckl_context_create()
|
||||
! ddim = elec_alpha_num
|
||||
! nupdates = 1
|
||||
! updates_index(1) = imo
|
||||
! breakdown = 1e-3
|
||||
! rc = qmckl_sherman_morrison_splitting(context, &
|
||||
! ddim, &
|
||||
! nupdates, &
|
||||
! updates, &
|
||||
! updates_index, &
|
||||
! breakdown, &
|
||||
! slater_matrix_alpha_inv_det(1:elec_alpha_num, 1:elec_alpha_num), &
|
||||
! ddet)
|
||||
! rc = qmckl_context_destroy(context)
|
||||
|
||||
! open(unit = 4000, file = "SlaterA.dat")
|
||||
! open(unit = 5000, file = "SlaterA_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)
|
||||
|
||||
! slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det * ddet
|
||||
|
||||
! if (ddet /= 0.d0) then
|
||||
! det_alpha_value_curr = ddet
|
||||
! else
|
||||
! n_to_do += 1
|
||||
! to_do(n_to_do) = k
|
||||
! ddet = det_alpha_value_curr
|
||||
! endif
|
||||
! enddo
|
||||
! if (n_to_do == n_to_do_old) then
|
||||
! ddet = 0.d0
|
||||
! exit
|
||||
! endif
|
||||
! enddo
|
||||
|
||||
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
|
||||
|
||||
else
|
||||
|
||||
ddet = 0.d0
|
||||
|
||||
endif
|
||||
|
||||
! Avoid NaN
|
||||
|
@ -474,7 +391,7 @@ END_PROVIDER
|
|||
|
||||
integer (qmckl_exit_code) :: rc
|
||||
integer (qmckl_context) :: context
|
||||
integer(c_int64_t) :: ddim, nupdates
|
||||
integer(c_int64_t) :: nupdates
|
||||
real(c_double) :: breakdown
|
||||
real(c_double), allocatable :: updates(:,:)
|
||||
|
||||
|
@ -569,26 +486,25 @@ END_PROVIDER
|
|||
ddet = 0.d0
|
||||
|
||||
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)
|
||||
|
||||
! 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
|
||||
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
|
||||
|
@ -604,144 +520,38 @@ END_PROVIDER
|
|||
|
||||
context = qmckl_context_create()
|
||||
breakdown = 1e-3
|
||||
rc = qmckl_sherman_morrison_smw32s(context, &
|
||||
rc = qmckl_sherman_morrison(context, &
|
||||
int(elec_beta_num_8, kind=8), &
|
||||
int(elec_beta_num, kind=8), &
|
||||
int(n_to_do, kind=8), &
|
||||
updates, &
|
||||
int(to_do, kind=8), &
|
||||
breakdown, &
|
||||
slater_matrix_beta_inv_det(1:elec_beta_num, 1:elec_beta_num), &
|
||||
slater_matrix_beta_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_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)
|
||||
|
||||
slater_matrix_beta_inv_det = slater_matrix_beta_inv_det * ddet
|
||||
det_beta_value_curr = ddet
|
||||
deallocate(updates)
|
||||
|
||||
|
||||
|
||||
! !! THIS WHOLE WHILE LOOP NEEDS TO BE REPLACED WITH 1 CALL TO QMCKL_SHERMAN_MORRISON_SMWB32S()
|
||||
! do while ( n_to_do > 0 )
|
||||
! ! 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")
|
||||
! 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)
|
||||
|
||||
! do i = 1,elec_beta_num
|
||||
! 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) = k
|
||||
! breakdown = 1e-3
|
||||
! rc = qmckl_sherman_morrison_splitting(context, &
|
||||
! ddim, &
|
||||
! nupdates, &
|
||||
! updates, &
|
||||
! updates_index, &
|
||||
! breakdown, &
|
||||
! slater_matrix_beta_inv_det(1:elec_beta_num, 1:elec_beta_num), &
|
||||
! ddet)
|
||||
! rc = qmckl_context_destroy(context)
|
||||
|
||||
! 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)
|
||||
|
||||
! slater_matrix_beta_inv_det = slater_matrix_beta_inv_det * ddet
|
||||
! stop
|
||||
|
||||
! if (ddet /= 0.d0) then
|
||||
! det_beta_value_curr = ddet
|
||||
! else
|
||||
! n_to_do += 1
|
||||
! to_do(n_to_do) = k
|
||||
! ddet = det_beta_value_curr
|
||||
! endif
|
||||
! enddo
|
||||
! if (n_to_do == n_to_do_old) then
|
||||
! ddet = 0.d0
|
||||
! exit
|
||||
! endif
|
||||
! enddo !! all updates have been done
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
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
|
||||
|
||||
else
|
||||
|
||||
ddet = 0.d0
|
||||
|
||||
endif
|
||||
|
||||
! Avoid NaN
|
||||
|
|
Loading…
Reference in New Issue