mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-09-12 10:48:31 +02:00
Fixed multi-state exc_max
This commit is contained in:
parent
a982b0d196
commit
239ba03231
@ -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, external :: diag_H_mat_elem_fock
|
||||||
double precision :: E_shift
|
double precision :: E_shift
|
||||||
double precision :: s_weight(N_states,N_states)
|
double precision :: s_weight(N_states,N_states)
|
||||||
|
PROVIDE dominant_dets_of_cfgs N_dominant_dets_of_cfgs
|
||||||
do jstate=1,N_states
|
do jstate=1,N_states
|
||||||
do istate=1,N_states
|
do istate=1,N_states
|
||||||
s_weight(istate,jstate) = dsqrt(selection_weight(istate)*selection_weight(jstate))
|
s_weight(istate,jstate) = dsqrt(selection_weight(istate)*selection_weight(jstate))
|
||||||
@ -777,8 +778,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
logical :: do_cycle
|
logical :: do_cycle
|
||||||
if (excitation_max >= 0) then
|
if (excitation_max >= 0) then
|
||||||
do_cycle = .True.
|
do_cycle = .True.
|
||||||
do k=1,N_states
|
do k=1,N_dominant_dets_of_cfgs
|
||||||
call get_excitation_degree(psi_det(1,1,dominant_det(k)),det(1,1),degree,N_int)
|
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)
|
do_cycle = do_cycle .and. (degree > excitation_max)
|
||||||
enddo
|
enddo
|
||||||
if (do_cycle) cycle
|
if (do_cycle) cycle
|
||||||
@ -787,8 +788,8 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
|
|
||||||
if (excitation_alpha_max >= 0) then
|
if (excitation_alpha_max >= 0) then
|
||||||
do_cycle = .True.
|
do_cycle = .True.
|
||||||
do k=1,N_states
|
do k=1,N_dominant_dets_of_cfgs
|
||||||
call get_excitation_degree_spin(psi_det(1,1,dominant_det(k)),det(1,1),degree,N_int)
|
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)
|
do_cycle = do_cycle .and. (degree > excitation_alpha_max)
|
||||||
enddo
|
enddo
|
||||||
if (do_cycle) cycle
|
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
|
if (excitation_beta_max >= 0) then
|
||||||
do_cycle = .True.
|
do_cycle = .True.
|
||||||
do k=1,N_states
|
do k=1,N_dominant_dets_of_cfgs
|
||||||
call get_excitation_degree_spin(psi_det(1,2,dominant_det(k)),det(1,2),degree,N_int)
|
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)
|
do_cycle = do_cycle .and. (degree > excitation_beta_max)
|
||||||
enddo
|
enddo
|
||||||
if (do_cycle) cycle
|
if (do_cycle) cycle
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user