mirror of
https://gitlab.com/scemama/qmcchem.git
synced 2024-07-25 20:27:26 +02:00
Introduced psi_det_tmp
This commit is contained in:
parent
5db05a2aee
commit
5657597900
37
src/wf.irp.f
37
src/wf.irp.f
@ -95,7 +95,7 @@ BEGIN_PROVIDER [ double precision, det_coef_matrix_dense, (det_alpha_num, det_be
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, det_num ]
|
BEGIN_PROVIDER [ integer, det_num ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Number of Det_a x Det_b products. The determinant basis set is reduced with
|
! 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)
|
double precision :: d_alpha(det_alpha_num), d_beta (det_beta_num)
|
||||||
integer :: i_alpha(det_alpha_num), i_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 :: iorder(max(det_alpha_num,det_beta_num))
|
||||||
|
integer*8, allocatable :: psi_det_tmp(:,:)
|
||||||
double precision :: t, norm
|
double precision :: t, norm
|
||||||
|
|
||||||
|
allocate (psi_det_tmp (N_int,max(det_alpha_num,det_beta_num)))
|
||||||
|
|
||||||
t = ci_threshold
|
t = ci_threshold
|
||||||
|
|
||||||
! Compute the norm of the alpha and beta determinants
|
! 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)
|
call isort(i_alpha,iorder,det_alpha_num)
|
||||||
|
|
||||||
i=det_alpha_num
|
i=det_alpha_num
|
||||||
do while (i > 0)
|
do while (i > 0)
|
||||||
if (i_alpha(i) <= det_alpha_num) then
|
if (i_alpha(i) <= det_alpha_num) then
|
||||||
det_alpha_num = i
|
det_alpha_num = i
|
||||||
exit
|
exit
|
||||||
@ -146,9 +149,12 @@ BEGIN_PROVIDER [ integer, det_num ]
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i=1,det_alpha_num
|
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
|
i_alpha(iorder(i)) = i
|
||||||
enddo
|
enddo
|
||||||
|
do i=1,det_alpha_num
|
||||||
|
psi_det_alpha(:,i) = psi_det_tmp(:,i)
|
||||||
|
enddo
|
||||||
|
|
||||||
! Reorder beta determinants
|
! Reorder beta determinants
|
||||||
do i=1,det_beta_num
|
do i=1,det_beta_num
|
||||||
@ -163,7 +169,7 @@ BEGIN_PROVIDER [ integer, det_num ]
|
|||||||
|
|
||||||
|
|
||||||
i=det_beta_num
|
i=det_beta_num
|
||||||
do while (i > 0)
|
do while (i > 0)
|
||||||
if (i_beta(i) <= det_beta_num) then
|
if (i_beta(i) <= det_beta_num) then
|
||||||
det_beta_num = i
|
det_beta_num = i
|
||||||
exit
|
exit
|
||||||
@ -173,11 +179,15 @@ BEGIN_PROVIDER [ integer, det_num ]
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i=1,det_beta_num
|
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
|
i_beta(iorder(i)) = i
|
||||||
enddo
|
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
|
! Apply the threshold to the wave function
|
||||||
l = 1
|
l = 1
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
@ -219,13 +229,13 @@ END_PROVIDER
|
|||||||
! Number of alpha and beta determinants
|
! Number of alpha and beta determinants
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: mod_align
|
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
|
det_beta_num_8 = max(4,mod_align(det_beta_num)) ! Used in 4x unrolling
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ci_threshold ]
|
BEGIN_PROVIDER [ double precision, ci_threshold ]
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Threshold on absolute value of the CI coefficients of the wave functioE
|
! 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
|
ci_threshold = 0.d0
|
||||||
call get_simulation_ci_threshold(ci_threshold)
|
call get_simulation_ci_threshold(ci_threshold)
|
||||||
call dinfo(irp_here,'ci_threshold',ci_threshold)
|
call dinfo(irp_here,'ci_threshold',ci_threshold)
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer*8, psi_det_alpha, (N_int,det_alpha_num) ]
|
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*8, intent(out) :: string(Nint)
|
||||||
integer, intent(in) :: list(Nint*64)
|
integer, intent(in) :: list(Nint*64)
|
||||||
integer, intent(in) :: n_elements
|
integer, intent(in) :: n_elements
|
||||||
|
|
||||||
|
|
||||||
integer :: i, j
|
integer :: i, j
|
||||||
integer :: ipos, iint
|
integer :: ipos, iint
|
||||||
|
|
||||||
!
|
!
|
||||||
! <== ipos ==>
|
! <== ipos ==>
|
||||||
! |
|
! |
|
||||||
! v
|
! v
|
||||||
!string :|------------------------|-------------------------|------------------------|
|
!string :|------------------------|-------------------------|------------------------|
|
||||||
! <==== 64 ====> <==== 64 ====> <==== 64 ====>
|
! <==== 64 ====> <==== 64 ====> <==== 64 ====>
|
||||||
! { iint } { iint } { iint }
|
! { iint } { iint } { iint }
|
||||||
!
|
!
|
||||||
|
|
||||||
string = 0_8
|
string = 0_8
|
||||||
|
|
||||||
@ -366,7 +376,6 @@ BEGIN_PROVIDER [ integer, det_alpha_order, (det_alpha_num) ]
|
|||||||
! Order in which to compute the alhpa determinants
|
! Order in which to compute the alhpa determinants
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i
|
integer :: i
|
||||||
! double precision :: tmp(det_alpha_num)
|
|
||||||
do i=1,det_alpha_num
|
do i=1,det_alpha_num
|
||||||
det_alpha_order(i) = i
|
det_alpha_order(i) = i
|
||||||
enddo
|
enddo
|
||||||
|
Loading…
Reference in New Issue
Block a user