add the possibility to avoid the skip in the generators with the select_max criterion and add a full_ci_no_skip.irp.f that uses it

scripts/generate_h_apply.py

@@ -133,6 +133,9 @@ class H_apply(object):
     self["filterparticle"] = """
      if(iand(ibset(0_bit_kind,j_a),hole(k_a,other_spin)).eq.0_bit_kind )cycle
     """
+  def unset_skip(self):
+    self["skip"] = """
+    """
 
 
   def set_filter_2h_2p(self):

src/Bitmask/bitmask_cas_routines.irp.f

@@ -214,13 +214,13 @@ logical function is_a_two_holes_two_particles(key_in)
  integer :: i,i_diff
  i_diff = 0
  if(N_int == 1)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
     + popcnt( iand( iand( xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1))), virt_bitmask(1,2) ), virt_bitmask(1,2)) ) 
  else if(N_int == 2)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
@@ -231,7 +231,7 @@ logical function is_a_two_holes_two_particles(key_in)
     + popcnt( iand( iand( xor(key_in(2,2),iand(key_in(2,2),cas_bitmask(2,2,1))), virt_bitmask(2,2) ), virt_bitmask(2,2)) ) 
 
  else if(N_int == 3)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
@@ -245,7 +245,7 @@ logical function is_a_two_holes_two_particles(key_in)
     + popcnt( iand( iand( xor(key_in(3,1),iand(key_in(3,1),cas_bitmask(3,1,1))), virt_bitmask(3,1) ), virt_bitmask(3,1)) ) & 
     + popcnt( iand( iand( xor(key_in(3,2),iand(key_in(3,2),cas_bitmask(3,2,1))), virt_bitmask(3,2) ), virt_bitmask(3,2)) ) 
  else if(N_int == 4)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
@@ -263,7 +263,7 @@ logical function is_a_two_holes_two_particles(key_in)
     + popcnt( iand( iand( xor(key_in(4,1),iand(key_in(4,1),cas_bitmask(4,1,1))), virt_bitmask(4,1) ), virt_bitmask(4,1)) ) & 
     + popcnt( iand( iand( xor(key_in(4,2),iand(key_in(4,2),cas_bitmask(4,2,1))), virt_bitmask(4,2) ), virt_bitmask(4,2)) ) 
  else if(N_int == 5)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
@@ -285,7 +285,7 @@ logical function is_a_two_holes_two_particles(key_in)
     + popcnt( iand( iand( xor(key_in(5,1),iand(key_in(5,1),cas_bitmask(5,1,1))), virt_bitmask(5,1) ), virt_bitmask(5,1)) ) & 
     + popcnt( iand( iand( xor(key_in(5,2),iand(key_in(5,2),cas_bitmask(5,2,1))), virt_bitmask(5,2) ), virt_bitmask(5,2)) ) 
  else if(N_int == 6)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
@@ -311,7 +311,7 @@ logical function is_a_two_holes_two_particles(key_in)
     + popcnt( iand( iand( xor(key_in(6,1),iand(key_in(6,1),cas_bitmask(6,1,1))), virt_bitmask(6,1) ), virt_bitmask(6,1)) ) & 
     + popcnt( iand( iand( xor(key_in(6,2),iand(key_in(6,2),cas_bitmask(6,2,1))), virt_bitmask(6,2) ), virt_bitmask(6,2)) ) 
  else if(N_int == 7)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
@@ -341,7 +341,7 @@ logical function is_a_two_holes_two_particles(key_in)
     + popcnt( iand( iand( xor(key_in(7,1),iand(key_in(7,1),cas_bitmask(7,1,1))), virt_bitmask(7,1) ), virt_bitmask(7,1)) ) & 
     + popcnt( iand( iand( xor(key_in(7,2),iand(key_in(7,2),cas_bitmask(7,2,1))), virt_bitmask(7,2) ), virt_bitmask(7,2)) ) 
  else if(N_int == 8)then
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(1,1), xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1)))), inact_bitmask(1,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(1,2), xor(key_in(1,2),iand(key_in(1,2),cas_bitmask(1,2,1)))), inact_bitmask(1,2)) )  &
     + popcnt( iand( iand( xor(key_in(1,1),iand(key_in(1,1),cas_bitmask(1,1,1))), virt_bitmask(1,1) ), virt_bitmask(1,1)) ) & 
@@ -378,7 +378,7 @@ logical function is_a_two_holes_two_particles(key_in)
  else
 
   do i = 1, N_int 
-   i_diff = i_diff  &
+   i_diff = i_diff + &
     + popcnt( xor( iand(inact_bitmask(i,1), xor(key_in(i,1),iand(key_in(i,1),cas_bitmask(i,1,1)))), inact_bitmask(i,1)) )  &   
     + popcnt( xor( iand(inact_bitmask(i,2), xor(key_in(i,2),iand(key_in(i,2),cas_bitmask(i,2,1)))), inact_bitmask(i,2)) )  &
     + popcnt( iand( iand( xor(key_in(i,1),iand(key_in(i,1),cas_bitmask(i,1,1))), virt_bitmask(i,1) ), virt_bitmask(i,1)) ) & 

src/Dets/save_for_casino.irp.f

@@ -4,7 +4,6 @@ subroutine save_casino
  character*(128) :: message
  integer                        :: getUnitAndOpen, iunit
  integer, allocatable           :: itmp(:)
- integer                        :: n_ao_new
  real, allocatable              :: rtmp(:)
  PROVIDE ezfio_filename
 
@@ -76,8 +75,7 @@ subroutine save_casino
     icount += 2*ao_l(i)+1
   endif
  enddo
- n_ao_new = icount
+ write(iunit,*) icount
- write(iunit,*) n_ao_new
  write(iunit,'(A)') 'Number of Gaussian primitives per primitive cell'
  allocate(itmp(ao_num))
  integer :: l
@@ -177,89 +175,6 @@ subroutine save_casino
  write(iunit,'(A)') 
  
 
- write(iunit,'(A)') 'MULTIDETERMINANT INFORMATION'
- write(iunit,'(A)') '----------------------------'
- write(iunit,'(A)') 'GS'
- write(iunit,'(A)') 'ORBITAL COEFFICIENTS'
- write(iunit,'(A)') '------------------------'
-
- ! Transformation cartesian -> spherical
- double precision :: tf2(6,5), tf3(10,7), tf4(15,9)
- integer :: check2(3,6), check3(3,10),  check4(3,15)
- check2(:,1)  = (/ 2, 0, 0 /)
- check2(:,2)  = (/ 1, 1, 0 /)
- check2(:,3)  = (/ 1, 0, 1 /)
- check2(:,4)  = (/ 0, 2, 0 /)
- check2(:,5)  = (/ 0, 1, 1 /)
- check2(:,6)  = (/ 0, 0, 2 /)
-
- check3(:,1)  = (/ 3, 0, 0 /)
- check3(:,2)  = (/ 2, 1, 0 /)
- check3(:,3)  = (/ 2, 0, 1 /)
- check3(:,4)  = (/ 1, 2, 0 /)
- check3(:,5)  = (/ 1, 1, 1 /)
- check3(:,6)  = (/ 1, 0, 2 /)
- check3(:,7)  = (/ 0, 3, 0 /)
- check3(:,8)  = (/ 0, 2, 1 /)
- check3(:,9)  = (/ 0, 1, 2 /)
- check3(:,10) = (/ 0, 0, 3 /)
-
- check4(:,1)  = (/ 4, 0, 0 /)
- check4(:,2)  = (/ 3, 1, 0 /)
- check4(:,3)  = (/ 3, 0, 1 /)
- check4(:,4)  = (/ 2, 2, 0 /)
- check4(:,5)  = (/ 2, 1, 1 /)
- check4(:,6)  = (/ 2, 0, 2 /)
- check4(:,7)  = (/ 1, 3, 0 /)
- check4(:,8)  = (/ 1, 2, 1 /)
- check4(:,9)  = (/ 1, 1, 2 /)
- check4(:,10) = (/ 1, 0, 3 /)
- check4(:,11) = (/ 0, 4, 0 /)
- check4(:,12) = (/ 0, 3, 1 /)
- check4(:,13) = (/ 0, 2, 2 /)
- check4(:,14) = (/ 0, 1, 3 /)
- check4(:,15) = (/ 0, 0, 4 /)
-
-! tf2 = (/
-!    -0.5, 0, 0, -0.5, 0, 1.0, &
-!    0, 0, 1.0, 0, 0, 0, &
-!    0, 0, 0, 0, 1.0, 0, &
-!    0.86602540378443864676, 0, 0, -0.86602540378443864676, 0, 0, &
-!    0, 1.0, 0, 0, 0, 0, &
-!  /)
-!  tf3 = (/
-!    0, 0, -0.67082039324993690892, 0, 0, 0, 0, -0.67082039324993690892, 0, 1.0, &
-!    -0.61237243569579452455, 0, 0, -0.27386127875258305673, 0, 1.0954451150103322269, 0, 0, 0, 0, &
-!    0, -0.27386127875258305673, 0, 0, 0, 0, -0.61237243569579452455, 0, 1.0954451150103322269, 0, &
-!    0, 0, 0.86602540378443864676, 0, 0, 0, 0, -0.86602540378443864676, 0, 0, &
-!    0, 0, 0, 0, 1.0, 0, 0, 0, 0, 0, &
-!    0.790569415042094833, 0, 0, -1.0606601717798212866, 0, 0, 0, 0, 0, 0, &
-!    0, 1.0606601717798212866, 0, 0, 0, 0, -0.790569415042094833, 0, 0, 0, &
-!  /)
-!  tf4 = (/
-!    0.375, 0, 0, 0.21957751641341996535, 0, -0.87831006565367986142, 0, 0, 0, 0, 0.375, 0, -0.87831006565367986142, 0, 1.0, &
-!    0, 0, -0.89642145700079522998, 0, 0, 0, 0, -0.40089186286863657703, 0, 1.19522860933439364, 0, 0, 0, 0, 0, &
-!    0, 0, 0, 0, -0.40089186286863657703, 0, 0, 0, 0, 0, 0, -0.89642145700079522998, 0, 1.19522860933439364, 0, &
-!    -0.5590169943749474241, 0, 0, 0, 0, 0.9819805060619657157, 0, 0, 0, 0, 0.5590169943749474241, 0, -0.9819805060619657157, 0, 0, &
-!    0, -0.42257712736425828875, 0, 0, 0, 0, -0.42257712736425828875, 0, 1.1338934190276816816, 0, 0, 0, 0, 0, 0, &
-!    0, 0, 0.790569415042094833, 0, 0, 0, 0, -1.0606601717798212866, 0, 0, 0, 0, 0, 0, 0, &
-!    0, 0, 0, 0, 1.0606601717798212866, 0, 0, 0, 0, 0, 0, -0.790569415042094833, 0, 0, 0, &
-!    0.73950997288745200532, 0, 0, -1.2990381056766579701, 0, 0, 0, 0, 0, 0, 0.73950997288745200532, 0, 0, 0, 0, &
-!    0, 1.1180339887498948482, 0, 0, 0, 0, -1.1180339887498948482, 0, 0, 0, 0, 0, 0, 0, 0, &
-!  /)
-!
-  
-
- allocate(rtmp(ao_num*mo_tot_num))
- l=0
- do i=1,mo_tot_num
-   do j=1,ao_num
-     l += 1
-     rtmp(l) = mo_coef(j,i)
-   enddo
- enddo
- write(iunit,'(4(1PE20.13))') rtmp(1:l)
- deallocate(rtmp)
  close(iunit) 
 end
 

src/Full_CI/H_apply.irp.f

@@ -10,6 +10,10 @@ s = H_apply("FCI_PT2")
 s.set_perturbation("epstein_nesbet_2x2")
 print s
 
+s = H_apply("FCI_no_skip")
+s.set_selection_pt2("epstein_nesbet_2x2")
+s.unset_skip()
+print s
 
 s = H_apply("FCI_mono")
 s.set_selection_pt2("epstein_nesbet_2x2")

src/Full_CI/full_ci_no_skip.irp.f

@@ -0,0 +1,91 @@
+program full_ci
+  implicit none
+  integer                        :: i,k
+
+  
+  double precision, allocatable  :: pt2(:), norm_pert(:), H_pert_diag(:)
+  integer                        :: N_st, degree
+  N_st = N_states
+  allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
+  character*(64)                 :: perturbation
+  
+  pt2 = 1.d0
+  diag_algorithm = "Lapack"
+  if (N_det > n_det_max_fci) then
+    call diagonalize_CI
+    call save_wavefunction
+    psi_det = psi_det_sorted
+    psi_coef = psi_coef_sorted
+    N_det = n_det_max_fci
+    soft_touch N_det psi_det psi_coef
+    call diagonalize_CI
+    call save_wavefunction
+    print *,  'N_det    = ', N_det
+    print *,  'N_states = ', N_states
+    print *,  'PT2      = ', pt2
+    print *,  'E        = ', CI_energy
+    print *,  'E+PT2    = ', CI_energy+pt2
+    print *,  '-----'
+  endif
+  double precision :: i_H_psi_array(N_states),diag_H_mat_elem,h,i_O1_psi_array(N_states)
+  if(read_wf)then
+   call i_H_psi(psi_det(1,1,N_det),psi_det,psi_coef,N_int,N_det,psi_det_size,N_states,i_H_psi_array)
+   h = diag_H_mat_elem(psi_det(1,1,N_det),N_int)
+   selection_criterion = dabs(psi_coef(N_det,1) *  (i_H_psi_array(1) - h * psi_coef(N_det,1))) * 0.1d0
+   soft_touch selection_criterion
+  endif
+
+
+  integer :: n_det_before
+  print*,'Beginning the selection ...'
+  do while (N_det < n_det_max_fci.and.maxval(abs(pt2(1:N_st))) > pt2_max)
+    n_det_before = N_det
+    call H_apply_FCI_no_skip(pt2, norm_pert, H_pert_diag,  N_st)
+
+    PROVIDE  psi_coef
+    PROVIDE  psi_det
+    PROVIDE  psi_det_sorted
+
+    if (N_det > n_det_max_fci) then
+       psi_det = psi_det_sorted
+       psi_coef = psi_coef_sorted
+       N_det = n_det_max_fci
+       soft_touch N_det psi_det psi_coef
+    endif
+    call diagonalize_CI
+    call save_wavefunction
+    if(n_det_before == N_det)then
+     selection_criterion = selection_criterion * 0.5d0
+    endif
+    print *,  'N_det    = ', N_det
+    print *,  'N_states = ', N_states
+    print *,  'PT2      = ', pt2
+    print *,  'E        = ', CI_energy
+    print *,  'E+PT2    = ', CI_energy+pt2
+    print *,  '-----'
+    call ezfio_set_full_ci_energy(CI_energy)
+    if (abort_all) then
+      exit
+    endif
+  enddo
+   N_det = min(n_det_max_fci,N_det)
+   touch N_det psi_det psi_coef
+   call diagonalize_CI
+   if(do_pt2_end)then
+    print*,'Last iteration only to compute the PT2'
+    threshold_selectors = 1.d0
+    threshold_generators = 0.999d0
+    call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag,  N_st)
+ 
+    print *,  'Final step'
+    print *,  'N_det    = ', N_det
+    print *,  'N_states = ', N_states
+    print *,  'PT2      = ', pt2
+    print *,  'E        = ', CI_energy
+    print *,  'E+PT2    = ', CI_energy+pt2
+    print *,  '-----'
+    call ezfio_set_full_ci_energy_pt2(CI_energy+pt2)
+   endif
+   call save_wavefunction
+  deallocate(pt2,norm_pert)
+end

src/Properties/need.irp.f

@@ -132,7 +132,7 @@
 ! <fortran>
       double precision function gammp(a,x)
       implicit double precision (a-h,o-z)
-      if(x.lt.0..or.a.le.0.)stop 'error in gammp'
+      if(x.lt.0..or.a.le.0.)pause
       if(x.lt.a+1.)then
         call gser(gammp,a,x,gln)
       else
@@ -169,7 +169,7 @@
       parameter (itmax=100,eps=3.e-7)
       gln=gammln(a)
       if(x.le.0.)then
-        if(x.lt.0.) stop 'error in gser'
+        if(x.lt.0.)pause
         gamser=0.
         return
       endif
@@ -182,7 +182,7 @@
         sum=sum+del
         if(abs(del).lt.abs(sum)*eps)go to 1
 11    continue
-      stop 'a too large, itmax too small'
+      pause 'a too large, itmax too small'
 1     gamser=sum*exp(-x+a*log(x)-gln)
       return
       end
@@ -233,7 +233,7 @@
           gold=g
         endif
 11    continue
-      stop 'a too large, itmax too small'
+      pause 'a too large, itmax too small'
 1     gammcf=exp(-x+a*log(x)-gln)*g
       return
       end

src/Utils/abort.irp.f

@@ -17,13 +17,16 @@ BEGIN_PROVIDER [ logical, abort_here ]
 END_PROVIDER
 
 subroutine trap_signals
+  use ifport
   implicit none
   BEGIN_DOC
   ! What to do when a signal is caught. Here, trap Ctrl-C and call the control_C subroutine.
   END_DOC
   integer, external              :: catch_signal
+  integer                        :: err, flag
   integer, parameter             :: sigusr2 = 12
-  call signal (sigusr2, catch_signal)
+  flag = -1
+  err = signal (sigusr2, catch_signal, flag)
 end subroutine trap_signals
 
 integer function catch_signal(signum)