corrected DDCI

scripts/generate_h_apply.py

@@ -13,8 +13,6 @@ initialization
 declarations
 decls_main
 keys_work
-do_double_excitations
-check_double_excitation
 copy_buffer
 finalization
 generate_psi_guess
@@ -25,8 +23,7 @@ deinit_thread
 skip
 init_main
 filter_integrals
-filterhole
-filterparticle
+filter2h2p
 """.split()
 
 class H_apply(object):
@@ -119,24 +116,13 @@ class H_apply(object):
       buffer = buffer.replace('$'+key, value)
     return buffer
 
-  def unset_double_excitations(self):
-    self["do_double_excitations"] = ".False."
-    self["check_double_excitation"] = """
-     check_double_excitation = .False.
-    """
-  def set_filter_holes(self):
-    self["filterhole"] = """
-     if(iand(ibset(0_bit_kind,j),hole(k,other_spin)).eq.0_bit_kind ) then
-        cycle
-     endif
-    """
-  def set_filter_particl(self):
-    self["filterparticle"] = """
-     if(iand(ibset(0_bit_kind,j_a),hole(k_a,other_spin)).eq.0_bit_kind ) then
-        cycle
-     endif
+  def set_filter_2h_2p(self):
+    self["filter2h2p"] = """
+!    ! DIR$ FORCEINLINE
+     if(is_a_two_holes_two_particles(key))cycle
     """
 
+
   def set_perturbation(self,pert):
     if self.perturbation is not None:
         raise
@@ -179,14 +165,9 @@ class H_apply(object):
       PROVIDE CI_electronic_energy psi_selectors_coef psi_selectors E_corr_per_selectors psi_det_sorted_bit
       """
       self.data["keys_work"] = """
-      if(check_double_excitation)then
-       call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
-        sum_norm_pert,sum_H_pert_diag,N_st,N_int)
-      else 
-       call perturb_buffer_by_mono_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
-        sum_norm_pert,sum_H_pert_diag,N_st,N_int)
-      endif
-      """%(pert,pert)
+      call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
+       sum_norm_pert,sum_H_pert_diag,N_st,N_int)
+      """%(pert,)
       self.data["finalization"] = """
       """
       self.data["copy_buffer"] = ""
@@ -252,7 +233,7 @@ class H_apply(object):
       if (s2_eig) then
         call make_s2_eigenfunction
       endif
-!     SOFT_TOUCH psi_det psi_coef N_det
+!      SOFT_TOUCH psi_det psi_coef N_det
       selection_criterion_min = min(selection_criterion_min, maxval(select_max))*0.1d0
       selection_criterion = selection_criterion_min
       call write_double(output_Dets,selection_criterion,'Selection criterion')

src/Dets/H_apply_template.f

@@ -26,6 +26,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
   integer                        :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2)
   
   double precision               :: mo_bielec_integral
+  logical                        :: is_a_two_holes_two_particles
   integer, allocatable           :: ia_ja_pairs(:,:,:)
   integer, allocatable           :: ib_jb_pairs(:,:)
   double precision               :: diag_H_mat_elem
@@ -35,11 +36,6 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
     ifirst=1
   endif
   
-  logical :: check_double_excitation 
-  check_double_excitation = .True.
-
-
-
   $initialization
   
   $omp_parallel
@@ -167,6 +163,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
           k = ishft(j_b-1,-bit_kind_shift)+1
           l = j_b-ishft(k-1,bit_kind_shift)-1
           key(k,other_spin) = ibset(key(k,other_spin),l)
+          $filter2h2p
           key_idx += 1
           do k=1,N_int
             keys_out(k,1,key_idx) = key(k,1)
@@ -215,6 +212,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene
         k = ishft(j_b-1,-bit_kind_shift)+1
         l = j_b-ishft(k-1,bit_kind_shift)-1
         key(k,ispin) = ibset(key(k,ispin),l)
+        $filter2h2p
         key_idx += 1
         do k=1,N_int
           keys_out(k,1,key_idx) = key(k,1)
@@ -272,17 +270,12 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc $param
   integer                        :: kk,pp,other_spin,key_idx
   integer                        :: N_elec_in_key_hole_1(2),N_elec_in_key_part_1(2)
   integer                        :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2)
+  logical                        :: is_a_two_holes_two_particles
   
   integer, allocatable           :: ia_ja_pairs(:,:,:)
   logical, allocatable           :: array_pairs(:,:)
   double precision               :: diag_H_mat_elem
   integer(omp_lock_kind), save   :: lck, ifirst=0
-
-  logical :: check_double_excitation 
-  check_double_excitation = .True.
-  $check_double_excitation
-
-
   if (ifirst == 0) then
     ifirst=1
 !$    call omp_init_lock(lck)
@@ -340,12 +333,11 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc $param
       hole = key_in
       k = ishft(i_a-1,-bit_kind_shift)+1
       j = i_a-ishft(k-1,bit_kind_shift)-1
-  $filterhole
       hole(k,ispin) = ibclr(hole(k,ispin),j)
       k_a = ishft(j_a-1,-bit_kind_shift)+1
       l_a = j_a-ishft(k_a-1,bit_kind_shift)-1
-  $filterparticle
       hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a)
+      $filter2h2p
       key_idx += 1
       do k=1,N_int
         keys_out(k,1,key_idx) = hole(k,1)

src/NEEDED_MODULES

@@ -1 +1 @@
-AOs BiInts Bitmask Dets Electrons Ezfio_files Full_CI Generators_full Hartree_Fock MOGuess MonoInts MOs Nuclei Output Selectors_full Utils Molden FCIdump Generators_CAS CAS_SD_selected 
+AOs BiInts Bitmask Dets Electrons Ezfio_files Full_CI Generators_full Hartree_Fock MOGuess MonoInts MOs Nuclei Output Selectors_full Utils Molden FCIdump Generators_CAS CAS_SD_selected DDCI_selected