Accelerated selection

scripts/generate_h_apply.py

@@ -20,6 +20,8 @@ init_thread
 printout_now
 printout_always
 deinit_thread
+skip
+init_main
 """.split()
 
 class H_apply(object):
@@ -201,6 +203,11 @@ class H_apply(object):
     self.set_perturbation(pert)
     self.selection_pt2 = pert
     if pert is not None:
+      self.data["parameters"] += ",select_max_out"
+      self.data["declarations"] += """
+      double precision, intent(inout) :: select_max_out"""
+
+      self.data["params_post"] += ", select_max(i_generator)"
       self.data["size_max"] = str(1024*128) 
       self.data["copy_buffer"] = """
       call copy_h_apply_buffer_to_wf
@@ -212,7 +219,24 @@ class H_apply(object):
       coef_pert_buffer = 0.d0
       """ + self.data["keys_work"]
       self.data["keys_work"] += """
-      call fill_H_apply_buffer_selection(key_idx,keys_out,e_2_pert_buffer,coef_pert_buffer,N_st,N_int,iproc)
+      call fill_H_apply_buffer_selection(key_idx,keys_out,e_2_pert_buffer, &
+        coef_pert_buffer,N_st,N_int,iproc,select_max_out) 
+      """
+      self.data["omp_parallel"]    += """&
+ !$OMP REDUCTION (max:select_max_out)"""
+      self.data["skip"] = """
+      if ((i_generator < size(select_max)).and. &
+        (select_max(i_generator) < selection_criterion_min*selection_criterion_factor)) then
+        !$ call omp_set_lock(lck)
+        do k=1,N_st
+          norm_psi(k) = norm_psi(k) + psi_coef(i_generator,k)*psi_coef(i_generator,k)
+          delta_pt2(k) = 0.d0
+          pt2_old(k) = 0.d0
+        enddo
+        !$ call omp_unset_lock(lck)
+        cycle
+      endif
+      select_max(i_generator) = 0.d0
       """
 
 

src/Dets/H_apply.irp.f

@@ -237,4 +237,3 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
 end
 
 
-

src/Dets/H_apply_template.f

@@ -369,6 +369,7 @@ subroutine $subroutine($params_main)
     if (abort_here) then
       cycle
     endif
+    $skip
     call $subroutine_diexc(psi_generators(1,1,i_generator),          &
         generators_bitmask(1,1,d_hole1,i_bitmask_gen),               &
         generators_bitmask(1,1,d_part1,i_bitmask_gen),               &
@@ -388,7 +389,7 @@ subroutine $subroutine($params_main)
     endif
     !$ call omp_unset_lock(lck)
   enddo
-  !$OMP END DO NOWAIT
+  !$OMP END DO 
   !$OMP END PARALLEL
   !$ call omp_destroy_lock(lck)
 
@@ -396,6 +397,7 @@ subroutine $subroutine($params_main)
     if (abort_here) then
       exit
     endif
+    $skip
     call $subroutine_diexc(psi_generators(1,1,i_generator),          &
         generators_bitmask(1,1,d_hole1,i_bitmask_gen),               &
         generators_bitmask(1,1,d_part1,i_bitmask_gen),               &

src/Dets/connected_to_ref.irp.f

@@ -32,10 +32,6 @@ logical function is_in_wavefunction(key,Nint,Ndet)
     i = ibegin + istep 
   end do
 
-! if (det_search /= det_ref) then
-!   return
-! endif
-
   do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref)
     i = i-1
     if (i == 0) then
@@ -43,6 +39,10 @@ logical function is_in_wavefunction(key,Nint,Ndet)
     endif
   enddo
   i += 1
+  if (i > N_det) then
+    return
+  endif
+
   do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref)
     if ( (key(1,1) /= psi_det_sorted_bit(1,1,i)).or.                               &
           (key(1,2) /= psi_det_sorted_bit(1,2,i)) ) then

src/Full_CI/full_ci.irp.f

@@ -11,7 +11,7 @@ program cisd
   
   pt2 = 1.d0
   diag_algorithm = "Lapack"
-  do while (maxval(abs(pt2(1:N_st))) > 1.d-2)
+  do while (maxval(abs(pt2(1:N_st))) > 1.d-3)
     call H_apply_FCI(pt2, norm_pert, H_pert_diag,  N_st)
     call diagonalize_CI
     print *,  'N_det    = ', N_det

src/Generators_full/generators.irp.f

@@ -52,4 +52,11 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_generators, (N_int,2,psi_det_size) ]
 
 END_PROVIDER
 
+ BEGIN_PROVIDER [ double precision, select_max, (3000) ]
+ implicit none
+ BEGIN_DOC
+ ! Memo to skip useless selectors
+ END_DOC
+ select_max = huge(1.d0)
+END_PROVIDER
 

src/Perturbation/selection.irp.f

@@ -1,4 +1,5 @@
-subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,coef_pert_buffer,N_st,Nint,iproc)
+subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,coef_pert_buffer, &
+   N_st,Nint,iproc,select_max_out)
   use bitmasks
   implicit none
   BEGIN_DOC
@@ -9,6 +10,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c
   integer(bit_kind), intent(in)  :: det_buffer(Nint,2,n_selected)
   double precision, intent(in)   :: e_2_pert_buffer(N_st,n_selected)
   double precision, intent(in)   :: coef_pert_buffer(N_st,n_selected)
+  double precision, intent(inout):: select_max_out
   integer                        :: i,j,k,l
   integer                        :: new_size
   double precision               :: s, smin, smax
@@ -35,6 +37,7 @@ subroutine fill_H_apply_buffer_selection(n_selected,det_buffer,e_2_pert_buffer,c
     do j=1,N_st
       s = -e_2_pert_buffer(j,i)
       is_selected = s > selection_criterion*selection_criterion_factor .or. is_selected
+      select_max_out = max(select_max_out,s)
     enddo
     
      
@@ -72,7 +75,7 @@ end
  BEGIN_DOC
  ! Threshold to select determinants. Set by selection routines.
  END_DOC
- selection_criterion =  10.d0 
+ selection_criterion =  .1d0 
  selection_criterion_factor = 0.01d0
  selection_criterion_min = selection_criterion
 
@@ -132,5 +135,3 @@ subroutine remove_small_contributions
 end
 
 
-
-