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

Multi-state Exc_max

Browse Source
This commit is contained in:
Anthony Scemama 2020-12-22 00:27:09 +01:00
parent b3e9c49514
commit 23a96f54ac
2 changed files with 40 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/cipsi/selection.irp.f
View File

@ -773,22 +773,35 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
endif endif
integer :: degree
logical :: do_cycle
if (excitation_max >= 0) then if (excitation_max >= 0) then
integer :: degree do_cycle = .True.
call get_excitation_degree(ref_bitmask(1,1),det(1,1),degree,N_int) do k=1,N_states
if (degree > excitation_max) cycle call get_excitation_degree(psi_det(1,1,dominant_det(k)),det(1,1),degree,N_int)
do_cycle = do_cycle .and. (degree > excitation_max)
enddo
if (do_cycle) cycle
endif endif
if (excitation_alpha_max >= 0) then if (excitation_alpha_max >= 0) then
call get_excitation_degree_spin(ref_bitmask(1,1),det(1,1),degree,N_int) do_cycle = .True.
if (degree > excitation_alpha_max) cycle do k=1,N_states
call get_excitation_degree_spin(psi_det(1,1,dominant_det(k)),det(1,1),degree,N_int)
do_cycle = do_cycle .and. (degree > excitation_alpha_max)
enddo
if (do_cycle) cycle
endif endif
if (excitation_beta_max >= 0) then if (excitation_beta_max >= 0) then
call get_excitation_degree_spin(ref_bitmask(1,2),det(1,2),degree,N_int) do_cycle = .True.
if (degree > excitation_beta_max) cycle do k=1,N_states
call get_excitation_degree_spin(psi_det(1,2,dominant_det(k)),det(1,2),degree,N_int)
do_cycle = do_cycle .and. (degree > excitation_beta_max)
enddo
if (do_cycle) cycle
endif endif

20
src/determinants/determinants.irp.f
View File

@ -256,6 +256,26 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib, (psi_det_size) ]
enddo enddo
END_PROVIDER END_PROVIDER
BEGIN_PROVIDER [ integer, dominant_det, (N_states) ]
implicit none
BEGIN_DOC
! Determinant with the largest weight, for each state
END_DOC
integer :: i, k
double precision :: wmax, c
do k=1,N_states
wmax = 0.d0
do i=1,N_det
c = psi_coef(i,k)*psi_coef(i,k)
if (c > wmax) then
dominant_det(k) = i
wmax = c
endif
enddo
enddo
END_PROVIDER
!==============================================================================! !==============================================================================!