simple untested minilist for all perturbations

config/gfortran.cfg

@@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32
 # 0 : Deactivate
 #
 [OPTION]
-MODE    : OPT        ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
+MODE    : DEBUG        ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
 CACHE   : 1          ; Enable cache_compile.py
 OPENMP  : 1          ; Append OpenMP flags
 

plugins/Perturbation/Moller_plesset.irp.f

@@ -31,7 +31,8 @@ subroutine pt2_moller_plesset(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_s
            (Fock_matrix_diag_mo(p1) + Fock_matrix_diag_mo(p2))
   delta_e = 1.d0/delta_e
 
-  call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array)
+  !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array)
+  call i_H_psi_nominilist(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array)
   h = diag_H_mat_elem(det_pert,Nint)
   do i =1,n_st
     H_pert_diag(i) = h

plugins/Perturbation/delta_rho_perturbation.irp.f

@@ -1,4 +1,4 @@
-subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st)
+subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
   integer, intent(in)            :: Nint,ndet,n_st
@@ -7,6 +7,10 @@ subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,nde
   double precision               :: i_O1_psi_array(N_st)
   double precision               :: i_H_psi_array(N_st)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the perturbatibe contribution to the Integrated Spin density at z = z_one point of one determinant
   !
@@ -46,7 +50,8 @@ subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,nde
 ! endif
   call i_O1_psi_alpha_beta(mo_integrated_delta_rho_one_point,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array)
 
-  call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
 
   h   = diag_H_mat_elem(det_pert,Nint)
   oii = diag_O1_mat_elem_alpha_beta(mo_integrated_delta_rho_one_point,det_pert,N_int)

plugins/Perturbation/dipole_moment.irp.f

@@ -1,4 +1,4 @@
-subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st)
+subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
   integer, intent(in)            :: Nint,ndet,n_st
@@ -7,6 +7,10 @@ subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_
   double precision               :: i_O1_psi_array(N_st)
   double precision               :: i_H_psi_array(N_st)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the perturbatibe contribution to the dipole moment of one determinant
   !
@@ -46,7 +50,9 @@ subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_
 ! endif
 
   call i_O1_psi(mo_dipole_z,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array)
-  call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
+  
   h = diag_H_mat_elem(det_pert,Nint)
   oii = diag_O1_mat_elem(mo_dipole_z,det_pert,N_int)
 

plugins/Perturbation/epstein_nesbet.irp.f

@@ -1,4 +1,4 @@
-subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st)
+subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
   integer, intent(in)            :: Nint,ndet,N_st
@@ -6,6 +6,10 @@ subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_s
   double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
   double precision               :: i_H_psi_array(N_st)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
   !
@@ -23,7 +27,10 @@ subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_s
 
   ASSERT (Nint == N_int)
   ASSERT (Nint > 0)
-  call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
+  
+  
   h = diag_H_mat_elem(det_pert,Nint)
   do i =1,N_st
     if(CI_electronic_energy(i)>h.and.CI_electronic_energy(i).ne.0.d0)then
@@ -45,11 +52,15 @@ end
 subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
-  integer, intent(in)            :: Nint,ndet,N_st, idx_minilist(0:N_det_selectors), N_minilist
+  integer, intent(in)            :: Nint,ndet,N_st
-  integer(bit_kind), intent(in)  :: det_pert(Nint,2), minilist(Nint,2,N_det_selectors)
+  integer(bit_kind), intent(in)  :: det_pert(Nint,2)
   double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
   double precision               :: i_H_psi_array(N_st)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the Epstein-Nesbet 2x2 diagonalization coefficient and energetic contribution
   !

plugins/Perturbation/pert_sc2.irp.f

@@ -1,5 +1,5 @@
 
-subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st)
+subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
   integer, intent(in)            :: Nint,ndet,N_st
@@ -8,6 +8,10 @@ subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag
   double precision               :: i_H_psi_array(N_st)
   integer                        :: idx_repeat(0:ndet)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
   !
@@ -84,7 +88,7 @@ subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag
 end
 
 
-subroutine pt2_epstein_nesbet_SC2_no_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st)
+subroutine pt2_epstein_nesbet_SC2_no_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
   integer, intent(in)            :: Nint,ndet,N_st
@@ -93,6 +97,10 @@ subroutine pt2_epstein_nesbet_SC2_no_projected(det_pert,c_pert,e_2_pert,H_pert_d
   double precision               :: i_H_psi_array(N_st)
   integer                        :: idx_repeat(0:ndet)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
   !
@@ -183,7 +191,7 @@ double precision function repeat_all_e_corr(key_in)
 end
 
 
-subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st)
+subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
   integer, intent(in)            :: Nint,ndet,N_st
@@ -191,6 +199,10 @@ subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet
   double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
   double precision               :: i_H_psi_array(N_st)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
   !
@@ -208,7 +220,10 @@ subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet
 
   ASSERT (Nint == N_int)
   ASSERT (Nint > 0)
-  call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+  call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
+
+  
   h = diag_H_mat_elem(det_pert,Nint)
   do i =1,N_st
     if(CI_SC2_electronic_energy(i)>h.and.CI_SC2_electronic_energy(i).ne.0.d0)then

plugins/Perturbation/pert_single.irp.f

@@ -1,4 +1,4 @@
-subroutine pt2_h_core(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st)
+subroutine pt2_h_core(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
   use bitmasks
   implicit none
   integer, intent(in)            :: Nint,ndet,N_st
@@ -6,6 +6,10 @@ subroutine pt2_h_core(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st)
   double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
   double precision               :: i_H_psi_array(N_st)
   
+  integer, intent(in)            :: N_minilist
+  integer, intent(in)            :: idx_minilist(0:N_det_selectors)
+  integer(bit_kind), intent(in)  :: minilist(Nint,2,N_det_selectors)
+  
   BEGIN_DOC
   ! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
   !

src/Determinants/slater_rules.irp.f

@@ -810,8 +810,43 @@ subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullLis
   end do
 end subroutine
 
-!call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
+subroutine i_H_psi_nominilist(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
-  call i_H_psi(det_pert,minilist,idx_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
+  use bitmasks
+  implicit none
+  integer, intent(in)            :: Nint, Ndet,Ndet_max,Nstate
+  integer(bit_kind), intent(in)  :: keys(Nint,2,Ndet)
+  integer(bit_kind), intent(in)  :: key(Nint,2)
+  double precision, intent(in)   :: coef(Ndet_max,Nstate)
+  double precision, intent(out)  :: i_H_psi_array(Nstate)
+  
+  integer                        :: i, ii,j
+  double precision               :: phase
+  integer                        :: exc(0:2,2,2)
+  double precision               :: hij
+  integer                        :: idx(0:Ndet)
+  BEGIN_DOC
+  ! <key|H|psi> for the various Nstates
+  END_DOC
+  
+  ASSERT (Nint > 0)
+  ASSERT (N_int == Nint)
+  ASSERT (Nstate > 0)
+  ASSERT (Ndet > 0)
+  ASSERT (Ndet_max >= Ndet)
+  i_H_psi_array = 0.d0
+  
+  call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
+  do ii=1,idx(0)
+    i = idx(ii)
+    !DEC$ FORCEINLINE
+    call i_H_j(keys(1,1,i),key,Nint,hij)
+    do j = 1, Nstate
+      i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
+    enddo
+  enddo
+end
+
+
 subroutine i_H_psi(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
   use bitmasks
   implicit none