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

Introduced psi_det_tmp

This commit is contained in:
Anthony Scemama 2020-07-17 21:18:10 +02:00
parent 5db05a2aee
commit 5657597900
1 changed files with 23 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
src/wf.irp.f
View File

@ -95,7 +95,7 @@ BEGIN_PROVIDER [ double precision, det_coef_matrix_dense, (det_alpha_num, det_be
END_PROVIDER
BEGIN_PROVIDER [ integer, det_num ]
BEGIN_PROVIDER [ integer, det_num ]
implicit none
BEGIN_DOC
! Number of Det_a x Det_b products. The determinant basis set is reduced with
@ -107,8 +107,11 @@ BEGIN_PROVIDER [ integer, det_num ]
double precision :: d_alpha(det_alpha_num), d_beta (det_beta_num)
integer :: i_alpha(det_alpha_num), i_beta(det_beta_num)
integer :: iorder(max(det_alpha_num,det_beta_num))
integer*8, allocatable :: psi_det_tmp(:,:)
double precision :: t, norm
allocate (psi_det_tmp (N_int,max(det_alpha_num,det_beta_num)))
t = ci_threshold
! Compute the norm of the alpha and beta determinants
@ -136,7 +139,7 @@ BEGIN_PROVIDER [ integer, det_num ]
call isort(i_alpha,iorder,det_alpha_num)
i=det_alpha_num
do while (i > 0)
do while (i > 0)
if (i_alpha(i) <= det_alpha_num) then
det_alpha_num = i
exit
@ -146,9 +149,12 @@ BEGIN_PROVIDER [ integer, det_num ]
enddo
do i=1,det_alpha_num
psi_det_alpha(:,i) = psi_det_alpha(:,iorder(i))
psi_det_tmp(:,i) = psi_det_alpha(:,iorder(i))
i_alpha(iorder(i)) = i
enddo
do i=1,det_alpha_num
psi_det_alpha(:,i) = psi_det_tmp(:,i)
enddo
! Reorder beta determinants
do i=1,det_beta_num
@ -163,7 +169,7 @@ BEGIN_PROVIDER [ integer, det_num ]
i=det_beta_num
do while (i > 0)
do while (i > 0)
if (i_beta(i) <= det_beta_num) then
det_beta_num = i
exit
@ -173,11 +179,15 @@ BEGIN_PROVIDER [ integer, det_num ]
enddo
do i=1,det_beta_num
psi_det_beta(:,i) = psi_det_beta(:,iorder(i))
psi_det_tmp(:,i) = psi_det_beta(:,iorder(i))
i_beta(iorder(i)) = i
enddo
do i=1,det_beta_num
psi_det_beta(:,i) = psi_det_tmp(:,i)
enddo
deallocate(psi_det_tmp)
! Apply the threshold to the wave function
l = 1
norm = 0.d0
@ -219,13 +229,13 @@ END_PROVIDER
! Number of alpha and beta determinants
END_DOC
integer :: mod_align
det_alpha_num_8 = max(4,mod_align(det_alpha_num)) !
det_alpha_num_8 = max(4,mod_align(det_alpha_num)) !
det_beta_num_8 = max(4,mod_align(det_beta_num)) ! Used in 4x unrolling
END_PROVIDER
BEGIN_PROVIDER [ double precision, ci_threshold ]
implicit none
BEGIN_DOC
! Threshold on absolute value of the CI coefficients of the wave functioE
@ -233,7 +243,7 @@ BEGIN_PROVIDER [ double precision, ci_threshold ]
ci_threshold = 0.d0
call get_simulation_ci_threshold(ci_threshold)
call dinfo(irp_here,'ci_threshold',ci_threshold)
END_PROVIDER
BEGIN_PROVIDER [ integer*8, psi_det_alpha, (N_int,det_alpha_num) ]
@ -335,19 +345,19 @@ subroutine list_to_bitstring( string, list, n_elements, Nint)
integer*8, intent(out) :: string(Nint)
integer, intent(in) :: list(Nint*64)
integer, intent(in) :: n_elements
integer :: i, j
integer :: ipos, iint
!
!
! <== ipos ==>
! |
! v
!string :|------------------------|-------------------------|------------------------|
! <==== 64 ====> <==== 64 ====> <==== 64 ====>
! { iint } { iint } { iint }
!
!
string = 0_8
@ -366,7 +376,6 @@ BEGIN_PROVIDER [ integer, det_alpha_order, (det_alpha_num) ]
! Order in which to compute the alhpa determinants
END_DOC
integer :: i
! double precision :: tmp(det_alpha_num)
do i=1,det_alpha_num
det_alpha_order(i) = i
enddo