LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-10-30 10:18:07 +01:00
Code Releases Activity

FIxed bug in CSF

Browse Source
This commit is contained in:
Anthony Scemama 2022-02-04 11:09:33 +01:00
parent dc42b639af
commit d428b721b2
5 changed files with 27 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/becke_numerical_grid/grid_becke_vector.irp.f
View File

@ -58,3 +58,17 @@ END_PROVIDER
enddo
END_PROVIDER
BEGIN_PROVIDER [double precision, final_grid_points_transp, (n_points_final_grid,3)]
implicit none
BEGIN_DOC
! Transposed final_grid_points
END_DOC
integer :: i,j
do j=1,3
do i=1,n_points_final_grid
final_grid_points_transp(i,j) = final_grid_points(j,i)
enddo
enddo
END_PROVIDER

21
src/csf/conversion.irp.f
View File

@ -65,22 +65,11 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out)
enddo
! Test 1
! if(iand(MS,1) .EQ. 0) then
! bfIcfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1))))
! else
! bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
! endif
! Test 2
! double precision :: binom1, binom2
! double precision, external :: logabsgamma
! binom1 = dexp(logabsgamma(1.0d0*(s+1)) &
! - logabsgamma(1.0d0*(((s+1)/2)+1)) &
! - logabsgamma(1.0d0*(s-(((s+1)/2))+1)));
! binom2 = dexp(logabsgamma(1.0d0*(s+1)) &
! - logabsgamma(1.0d0*((((s+3)/2)+1)+1)) &
! - logabsgamma(1.0d0*(s-(((s+3)/2)+1)+1)));
! bfIcfg = max(1,nint(binom1 - binom2))
if(iand(MS,1) .EQ. 0) then
bfIcfg = max(1,nint((binom(s,s/2)-binom(s,s/2+1))))
else
bfIcfg = max(1,nint((binom(s,(s+1)/2)-binom(s,((s+1)/2)+1))))
endif
! perhaps blocking with CFGs of same seniority
! can be more efficient

18
src/csf/sigma_vector.irp.f
View File

@ -65,23 +65,9 @@
dimcsfpercfg = 2
else
if(iand(MS,1) .EQ. 0) then
! dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1))))
binom1 = dexp(logabsgamma(1.0d0*(i+1)) &
- logabsgamma(1.0d0*((i/2)+1)) &
- logabsgamma(1.0d0*(i-((i/2))+1)));
binom2 = dexp(logabsgamma(1.0d0*(i+1)) &
- logabsgamma(1.0d0*(((i/2)+1)+1)) &
- logabsgamma(1.0d0*(i-((i/2)+1)+1)));
dimcsfpercfg = max(1,nint(binom1 - binom2))
dimcsfpercfg = max(1,nint((binom(i,i/2)-binom(i,i/2+1))))
else
! dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2))))
binom1 = dexp(logabsgamma(1.0d0*(i+1)) &
- logabsgamma(1.0d0*(((i+1)/2)+1)) &
- logabsgamma(1.0d0*(i-(((i+1)/2))+1)));
binom2 = dexp(logabsgamma(1.0d0*(i+1)) &
- logabsgamma(1.0d0*((((i+3)/2)+1)+1)) &
- logabsgamma(1.0d0*(i-(((i+3)/2)+1)+1)));
dimcsfpercfg = max(1,nint(binom1 - binom2))
dimcsfpercfg = max(1,nint((binom(i,(i+1)/2)-binom(i,(i+3)/2))))
endif
endif
n_CSF += ncfg * dimcsfpercfg

2
src/davidson/diagonalize_ci.irp.f
View File

@ -3,6 +3,7 @@ BEGIN_PROVIDER [ double precision, CI_energy, (N_states_diag) ]
BEGIN_DOC
! :c:data:`n_states` lowest eigenvalues of the |CI| matrix
END_DOC
PROVIDE distributed_davidson
integer :: j
character*(8) :: st
@ -246,6 +247,7 @@ subroutine diagonalize_CI
! eigenstates of the |CI| matrix.
END_DOC
integer :: i,j
PROVIDE distributed_davidson
do j=1,N_states
do i=1,N_det
psi_coef(i,j) = CI_eigenvectors(i,j)

6
src/utils/sort.irp.f
View File

@ -356,7 +356,8 @@ BEGIN_TEMPLATE
if ( isize < 32) then
call insertion_$Xsort(x,iorder,isize)
else
call $Xradix_sort(x,iorder,isize,-1)
! call $Xradix_sort(x,iorder,isize,-1)
call quick_$Xsort(x,iorder,isize)
endif
end subroutine $Xsort
@ -450,7 +451,8 @@ BEGIN_TEMPLATE
if ( isize < 32) then
call insertion_$Xsort(x,iorder,isize)
else
call $Xradix_sort(x,iorder,isize,-1)
! call $Xradix_sort(x,iorder,isize,-1)
call quick_$Xsort(x,iorder,isize)
endif
end subroutine $Xsort