162 lines
5.8 KiB
Fortran
162 lines
5.8 KiB
Fortran
use bitmasks
|
|
|
|
BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_tc, (psi_det_size) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Contribution of determinants to the state-averaged density.
|
|
END_DOC
|
|
integer :: i,j,k
|
|
double precision :: f
|
|
|
|
psi_average_norm_contrib_tc(:) = 0.d0
|
|
do k=1,N_states
|
|
do i=1,N_det
|
|
! print*,dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k)),psi_l_coef_bi_ortho(i,k),psi_r_coef_bi_ortho(i,k)
|
|
psi_average_norm_contrib_tc(i) += &
|
|
dabs(psi_l_coef_bi_ortho(i,k)*psi_r_coef_bi_ortho(i,k))*state_average_weight(k)
|
|
enddo
|
|
enddo
|
|
! print*,'***'
|
|
! do i = 1, N_det
|
|
! print*,psi_average_norm_contrib_tc(i)
|
|
! enddo
|
|
print*,'sum(psi_average_norm_contrib_tc(1:N_det))',sum(psi_average_norm_contrib_tc(1:N_det))
|
|
f = 1.d0/sum(psi_average_norm_contrib_tc(1:N_det))
|
|
do i=1,N_det
|
|
psi_average_norm_contrib_tc(i) = psi_average_norm_contrib_tc(i)*f
|
|
enddo
|
|
f = 0.d0
|
|
do i=1,N_det
|
|
f+= psi_average_norm_contrib_tc(i)
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc, (N_int,2,psi_det_size) ]
|
|
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc, (psi_det_size,N_states) ]
|
|
&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_tc, (psi_det_size) ]
|
|
&BEGIN_PROVIDER [ integer, psi_det_sorted_tc_order, (psi_det_size) ]
|
|
&BEGIN_PROVIDER [double precision, psi_r_coef_sorted_bi_ortho, (psi_det_size, N_states)]
|
|
&BEGIN_PROVIDER [double precision, psi_l_coef_sorted_bi_ortho, (psi_det_size, N_states)]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Wave function sorted by determinants contribution to the norm (state-averaged)
|
|
!
|
|
! psi_det_sorted_tc_order(i) -> k : index in psi_det
|
|
!
|
|
! psi_r_coef_sorted_bi_ortho : right coefficients corresponding to psi_det_sorted_tc
|
|
!
|
|
! psi_l_coef_sorted_bi_ortho : left coefficients corresponding to psi_det_sorted_tc
|
|
END_DOC
|
|
integer :: i,j,k
|
|
integer, allocatable :: iorder(:)
|
|
allocate ( iorder(N_det) )
|
|
do i=1,N_det
|
|
iorder(i) = i
|
|
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i)
|
|
enddo
|
|
call dsort(psi_average_norm_contrib_sorted_tc,iorder,N_det)
|
|
do i=1,N_det
|
|
psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_sorted_tc(i)
|
|
do j=1,N_int
|
|
psi_det_sorted_tc(j,1,i) = psi_det(j,1,iorder(i))
|
|
psi_det_sorted_tc(j,2,i) = psi_det(j,2,iorder(i))
|
|
enddo
|
|
psi_det_sorted_tc_order(iorder(i)) = i
|
|
enddo
|
|
double precision :: accu
|
|
do k=1,N_states
|
|
accu = 0.d0
|
|
do i=1,N_det
|
|
psi_coef_sorted_tc(i,k) = dsqrt(psi_average_norm_contrib_sorted_tc(i))
|
|
accu += psi_coef_sorted_tc(i,k)**2
|
|
enddo
|
|
accu = 1.d0/dsqrt(accu)
|
|
do i=1,N_det
|
|
psi_coef_sorted_tc(i,k) *= accu
|
|
enddo
|
|
enddo
|
|
|
|
psi_det_sorted_tc(:,:,N_det+1:psi_det_size) = 0_bit_kind
|
|
psi_coef_sorted_tc(N_det+1:psi_det_size,:) = 0.d0
|
|
psi_average_norm_contrib_sorted_tc(N_det+1:psi_det_size) = 0.d0
|
|
psi_det_sorted_tc_order(N_det+1:psi_det_size) = 0
|
|
|
|
psi_r_coef_sorted_bi_ortho = 0.d0
|
|
psi_l_coef_sorted_bi_ortho = 0.d0
|
|
do i = 1, N_det
|
|
psi_r_coef_sorted_bi_ortho(i,1:N_states) = psi_r_coef_bi_ortho(iorder(i),1:N_states)
|
|
psi_l_coef_sorted_bi_ortho(i,1:N_states) = psi_l_coef_bi_ortho(iorder(i),1:N_states)
|
|
enddo
|
|
deallocate(iorder)
|
|
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_bit, (N_int,2,psi_det_size) ]
|
|
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_tc_bit, (psi_det_size,N_states) ]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation.
|
|
! They are sorted by determinants interpreted as integers. Useful
|
|
! to accelerate the search of a random determinant in the wave
|
|
! function.
|
|
END_DOC
|
|
|
|
call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, size(psi_coef,1), &
|
|
psi_det_sorted_tc_bit, psi_coef_sorted_tc_bit, N_states)
|
|
|
|
END_PROVIDER
|
|
|
|
|
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_right, (N_int,2,N_det) ]
|
|
&BEGIN_PROVIDER [double precision, psi_r_coef_sorted_bi_ortho_right, (N_det)]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! psi_det_sorted_tc_right : Slater determinants sorted by decreasing value of |right- coefficients|
|
|
!
|
|
! psi_r_coef_sorted_bi_ortho_right : right wave function according to psi_det_sorted_tc_right
|
|
END_DOC
|
|
integer, allocatable :: iorder(:)
|
|
double precision, allocatable :: coef(:)
|
|
integer :: i,j
|
|
allocate ( iorder(N_det) , coef(N_det))
|
|
do i=1,N_det
|
|
coef(i) = -dabs(psi_r_coef_bi_ortho(i,1)/psi_r_coef_bi_ortho(1,1))
|
|
iorder(i) = i
|
|
enddo
|
|
call dsort(coef,iorder,N_det)
|
|
do i=1,N_det
|
|
do j=1,N_int
|
|
psi_det_sorted_tc_right(j,1,i) = psi_det(j,1,iorder(i))
|
|
psi_det_sorted_tc_right(j,2,i) = psi_det(j,2,iorder(i))
|
|
enddo
|
|
psi_r_coef_sorted_bi_ortho_right(i) = psi_r_coef_bi_ortho(iorder(i),1)/psi_r_coef_bi_ortho(iorder(1),1)
|
|
enddo
|
|
END_PROVIDER
|
|
|
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_tc_left, (N_int,2,N_det) ]
|
|
&BEGIN_PROVIDER [double precision, psi_l_coef_sorted_bi_ortho_left, (N_det)]
|
|
implicit none
|
|
BEGIN_DOC
|
|
! psi_det_sorted_tc_left : Slater determinants sorted by decreasing value of |LEFTt- coefficients|
|
|
!
|
|
! psi_r_coef_sorted_bi_ortho_left : LEFT wave function according to psi_det_sorted_tc_left
|
|
END_DOC
|
|
integer, allocatable :: iorder(:)
|
|
double precision, allocatable :: coef(:)
|
|
integer :: i,j
|
|
allocate ( iorder(N_det) , coef(N_det))
|
|
do i=1,N_det
|
|
coef(i) = -dabs(psi_l_coef_bi_ortho(i,1)/psi_r_coef_bi_ortho(1,1))
|
|
iorder(i) = i
|
|
enddo
|
|
call dsort(coef,iorder,N_det)
|
|
do i=1,N_det
|
|
do j=1,N_int
|
|
psi_det_sorted_tc_left(j,1,i) = psi_det(j,1,iorder(i))
|
|
psi_det_sorted_tc_left(j,2,i) = psi_det(j,2,iorder(i))
|
|
enddo
|
|
psi_l_coef_sorted_bi_ortho_left(i) = psi_l_coef_bi_ortho(iorder(i),1)/psi_l_coef_bi_ortho(iorder(1),1)
|
|
enddo
|
|
END_PROVIDER
|