Fixed multi-state exc_max

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
+        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
         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
+        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) 
         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
+        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) 
         enddo
         if (do_cycle) cycle

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