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

Fixed multi-state exc_max

Browse Source
This commit is contained in:
Anthony Scemama 2020-12-22 01:36:04 +01:00
parent a982b0d196
commit 239ba03231
2 changed files with 52 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -679,6 +679,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
double precision, external :: diag_H_mat_elem_fock
double precision :: E_shift
double precision :: s_weight(N_states,N_states)
PROVIDE dominant_dets_of_cfgs N_dominant_dets_of_cfgs
do jstate=1,N_states
do istate=1,N_states
s_weight(istate,jstate) = dsqrt(selection_weight(istate)*selection_weight(jstate))
@ -777,9 +778,9 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
logical :: do_cycle
if (excitation_max >= 0) then
do_cycle = .True.
do k=1,N_states
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)
do k=1,N_dominant_dets_of_cfgs
call get_excitation_degree(dominant_dets_of_cfgs(1,1,k),det(1,1),degree,N_int)
do_cycle = do_cycle .and. (degree > excitation_max)
enddo
if (do_cycle) cycle
endif
@ -787,8 +788,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
if (excitation_alpha_max >= 0) then
do_cycle = .True.
do k=1,N_states
call get_excitation_degree_spin(psi_det(1,1,dominant_det(k)),det(1,1),degree,N_int)
do k=1,N_dominant_dets_of_cfgs
call get_excitation_degree(dominant_dets_of_cfgs(1,1,k),det(1,1),degree,N_int)
do_cycle = do_cycle .and. (degree > excitation_alpha_max)
enddo
if (do_cycle) cycle
@ -797,8 +798,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
if (excitation_beta_max >= 0) then
do_cycle = .True.
do k=1,N_states
call get_excitation_degree_spin(psi_det(1,2,dominant_det(k)),det(1,2),degree,N_int)
do k=1,N_dominant_dets_of_cfgs
call get_excitation_degree(dominant_dets_of_cfgs(1,1,k),det(1,1),degree,N_int)
do_cycle = do_cycle .and. (degree > excitation_beta_max)
enddo
if (do_cycle) cycle

44
src/determinants/configurations.irp.f
View File

@ -519,3 +519,47 @@ end
BEGIN_PROVIDER [ integer, dominant_cfg, (N_states) ]
implicit none
BEGIN_DOC
! Configuration of the determinants with the largest weight, for each state
END_DOC
integer :: k
do k=1,N_states
dominant_cfg(k) = det_to_configuration(dominant_det(k))
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer, N_dominant_dets_of_cfgs ]
implicit none
BEGIN_DOC
! Number of determinants in all dominant determinants
END_DOC
integer :: k, sze
N_dominant_dets_of_cfgs = 0
do k=1,N_states
call configuration_to_dets_size( &
psi_configuration(1,1,dominant_cfg(k)), &
sze, elec_alpha_num, N_int)
N_dominant_dets_of_cfgs += sze
enddo
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), dominant_dets_of_cfgs, (N_int,2,N_dominant_dets_of_cfgs) ]
implicit none
BEGIN_DOC
! Configuration of the determinants with the largest weight, for each state
END_DOC
integer :: i,k,sze
i=1
do k=1,N_states
sze = N_dominant_dets_of_cfgs
call configuration_to_dets( &
psi_configuration(1,1,dominant_cfg(k)), &
dominant_dets_of_cfgs(1,1,i), &
sze,elec_alpha_num,N_int)
i += sze
enddo
END_PROVIDER