LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 19:13:29 +01:00
Code Releases Activity

Merge branch 'dev' of github.com:QuantumPackage/qp2 into dev

Browse Source
This commit is contained in:
Anthony Scemama 2022-02-22 13:39:46 +01:00
commit 0052fb92ff
8 changed files with 41 additions and 58 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

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

@ -58,29 +58,17 @@ subroutine convertWFfromDETtoCSF(N_st,psi_coef_det_in, psi_coef_cfg_out)
enddo
enddo
s = 0
s = 0 ! s == total number of SOMOs
do k=1,N_int
if (psi_configuration(k,1,i) == 0_bit_kind) cycle
s = s + popcnt(psi_configuration(k,1,i))
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(s,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

23
src/davidson/diagonalization_hcsf_dressed.irp.f
View File

@ -299,7 +299,7 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
shift = N_st_diag*(iter-1)
shift2 = N_st_diag*iter
if ((iter > 1).or.(itertot == 1)) then
! if ((iter > 1).or.(itertot == 1)) then
! Compute |W_k> = \sum_i |i><i|H|u_k>
! -----------------------------------
@ -309,10 +309,10 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
else
call H_u_0_nstates_openmp(W,U,N_st_diag,sze)
endif
else
! Already computed in update below
continue
endif
! else
! ! Already computed in update below
! continue
! endif
if (dressing_state > 0) then
@ -508,17 +508,8 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N
enddo
! Re-contract U and update W
! --------------------------------
call dgemm('N','N', sze_csf, N_st_diag, shift2, 1.d0, &
W_csf, size(W_csf,1), y, size(y,1), 0.d0, u_in, size(u_in,1))
do k=1,N_st_diag
do i=1,sze_csf
W_csf(i,k) = u_in(i,k)
enddo
enddo
call convertWFfromCSFtoDET(N_st_diag,W_csf,W)
! Re-contract U
! -------------
call dgemm('N','N', sze_csf, N_st_diag, shift2, 1.d0, &
U_csf, size(U_csf,1), y, size(y,1), 0.d0, u_in, size(u_in,1))

10
src/davidson/diagonalization_hs2_dressed.irp.f
View File

@ -349,7 +349,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
shift = N_st_diag*(iter-1)
shift2 = N_st_diag*iter
if ((iter > 1).or.(itertot == 1)) then
! if ((iter > 1).or.(itertot == 1)) then
! Compute |W_k> = \sum_i |i><i|H|u_k>
! -----------------------------------
@ -359,10 +359,10 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_
call H_S2_u_0_nstates_openmp(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze)
endif
S(1:sze,shift+1:shift+N_st_diag) = real(S_d(1:sze,1:N_st_diag))
else
! Already computed in update below
continue
endif
! else
! ! Already computed in update below
! continue
! endif
if (dressing_state > 0) then

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)

2
src/utils/set_multiple_levels_omp.irp.f
View File

@ -8,7 +8,7 @@ subroutine set_multiple_levels_omp(activate)
logical, intent(in) :: activate
if (activate) then
call omp_set_max_active_levels(5)
call omp_set_max_active_levels(3)
IRP_IF SET_NESTED
call omp_set_nested(.True.)

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