diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index bddf7095..12cd623a 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -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 diff --git a/src/determinants/configurations.irp.f b/src/determinants/configurations.irp.f index c703a866..5fb187e1 100644 --- a/src/determinants/configurations.irp.f +++ b/src/determinants/configurations.irp.f @@ -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