Compiles with gfortran

plugins/Full_CI_ZMQ/selection_slave.irp.f

@@ -63,7 +63,7 @@ subroutine update_energy(energy)
       CI_eigenvectors(k,j) = psi_coef(k,j)
     enddo
   enddo
-  call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
+  call u_0_S2_u_0_nstates(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int)
   if (.True.) then
     do k=1,size(ci_electronic_energy)
       ci_electronic_energy(k) = energy(k)

plugins/MRCC_Utils/davidson.irp.f

@@ -377,22 +377,6 @@ subroutine davidson_diag_hjj_mrcc(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nin
 end
 
 
-subroutine u_0_H_u_0_mrcc(e_0,u_0,n,keys_tmp,Nint,istate)
-  use bitmasks
-  implicit none
-  BEGIN_DOC
-  ! Computes e_0 = <u_0|H|u_0>/<u_0|u_0>
-  !
-  ! n : number of determinants
-  !
-  END_DOC
-  integer, intent(in)            :: n,Nint,istate
-  double precision, intent(out)  :: e_0
-  double precision, intent(in)   :: u_0(n)
-  integer(bit_kind),intent(in)   :: keys_tmp(Nint,2,n)
-  call u_0_H_u_0_mrcc_nstates(e_0,u_0,n,keys_tmp,Nint,1,n,istate)
-end
-
 subroutine u_0_H_u_0_mrcc_nstates(e_0,u_0,n,keys_tmp,Nint,istate,N_st,sze_8)
   use bitmasks
   implicit none
@@ -428,24 +412,6 @@ subroutine u_0_H_u_0_mrcc_nstates(e_0,u_0,n,keys_tmp,Nint,istate,N_st,sze_8)
 end
 
 
-subroutine H_u_0_mrcc(v_0,u_0,H_jj,n,keys_tmp,Nint,istate_in)
-  use bitmasks
-  implicit none
-  BEGIN_DOC
-  ! Computes v_0 = H|u_0>
-  !
-  ! n : number of determinants
-  !
-  ! H_jj : array of <j|H|j>
-  END_DOC
-  integer, intent(in)            :: n,Nint,istate_in
-  double precision, intent(out)  :: v_0(n)
-  double precision, intent(in)   :: u_0(n)
-  double precision, intent(in)   :: H_jj(n)
-  integer(bit_kind),intent(in)   :: keys_tmp(Nint,2,n)
-  call H_u_0_mrcc_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,1,n)
-end
-
 subroutine H_u_0_mrcc_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,istate_in,N_st,sze_8)
   use bitmasks
   implicit none

src/Davidson/u0Hu0.irp.f

@@ -1,19 +1,3 @@
-subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint)
-  use bitmasks
-  implicit none
-  BEGIN_DOC
-  ! Computes e_0 = <u_0|H|u_0>/<u_0|u_0>
-  !
-  ! n : number of determinants
-  !
-  END_DOC
-  integer, intent(in)            :: n,Nint
-  double precision, intent(out)  :: e_0
-  double precision, intent(in)   :: u_0(n)
-  integer(bit_kind),intent(in)   :: keys_tmp(Nint,2,n)
-  call u_0_H_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,1,n)
-end
-
 subroutine u_0_H_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
   use bitmasks
   implicit none

src/Determinants/guess_lowest_state.irp.f

@@ -1,162 +0,0 @@
-program first_guess
-  use bitmasks
-  implicit none
-  BEGIN_DOC
-  ! Select all the determinants with the lowest energy as a starting point.
-  END_DOC
-  integer                        :: i,j
-  double precision, allocatable  :: orb_energy(:)
-  double precision               :: E
-  integer, allocatable           :: kept(:)
-  integer                        :: nelec_kept(2)
-  character                      :: occ_char, keep_char
-  
-  PROVIDE H_apply_buffer_allocated psi_det
-  allocate (orb_energy(mo_tot_num), kept(0:mo_tot_num))
-  nelec_kept(1:2) = 0
-  kept(0) = 0
-
-  print *,  'Orbital energies'
-  print *,  '================'
-  print *,  ''
-  do i=1,mo_tot_num
-    keep_char = ' '
-    occ_char = '-'
-    orb_energy(i) = mo_mono_elec_integral(i,i)
-    do j=1,elec_beta_num
-      if (i==j) cycle
-      orb_energy(i) += mo_bielec_integral_jj_anti(i,j)
-    enddo
-    do j=1,elec_alpha_num
-      orb_energy(i) += mo_bielec_integral_jj(i,j)
-    enddo
-    if ( (orb_energy(i) > -.5d0).and.(orb_energy(i) < .1d0) ) then
-      kept(0) += 1
-      keep_char = 'X'
-      kept( kept(0) ) = i
-      if (i <= elec_beta_num) then
-        nelec_kept(2) += 1
-      endif
-      if (i <= elec_alpha_num) then
-        nelec_kept(1) += 1
-      endif
-    endif
-    if (i <= elec_alpha_num) then
-      if (i <= elec_beta_num) then
-        occ_char = '#'
-      else
-        occ_char = '+'
-      endif
-    endif
-    print '(I4, 3X, A, 3X, F10.6, 3X, A)', i, occ_char, orb_energy(i), keep_char 
-  enddo
-
-  
-  integer, allocatable           :: list  (:,:)
-  integer(bit_kind), allocatable :: string(:,:)
-  allocate ( list(N_int*bit_kind_size,2), string(N_int,2) )
-
-  string = ref_bitmask
-  call bitstring_to_list( string(1,1), list(1,1), elec_alpha_num, N_int)
-  call bitstring_to_list( string(1,2), list(1,2), elec_beta_num , N_int)
-
-  psi_det_alpha_unique(:,1) = string(:,1)
-  psi_det_beta_unique (:,1) = string(:,2)
-  N_det_alpha_unique = 1
-  N_det_beta_unique  = 1
-
-  integer :: i1,i2,i3,i4,i5,i6,i7,i8,i9
-
-  psi_det_size = kept(0)**(nelec_kept(1)+nelec_kept(2))
-  print *,  kept(0), nelec_kept(:)
-  call write_int(6,psi_det_size,'psi_det_size')
-  TOUCH psi_det_size
-
-BEGIN_SHELL [ /usr/bin/python ]
-
-template_alpha_ext = """
-do %(i2)s = %(i1)s-1,1,-1
-  list(elec_alpha_num-%(i)d,1) = kept(%(i2)s)
-  call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int)
-"""
-
-template_alpha = """
-do %(i2)s = %(i1)s-1,1,-1
-  list(elec_alpha_num-%(i)d,1) = kept(%(i2)s)
-  call list_to_bitstring( string(1,1), list(1,1), elec_alpha_num, N_int)
-  N_det_alpha_unique += 1
-  psi_det_alpha_unique(:,N_det_alpha_unique) = string(:,1)
-"""
-
-template_beta_ext = """
-do %(i2)s = %(i1)s-1,1,-1
-  list(elec_beta_num-%(i)d,2) = kept(%(i2)s)
-  call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int)
-"""
-template_beta = """
-do %(i2)s = %(i1)s-1,1,-1
-  list(elec_beta_num-%(i)d,2) = kept(%(i2)s)
-  call list_to_bitstring( string(1,2), list(1,2), elec_beta_num, N_int)
-  N_det_beta_unique += 1
-  psi_det_beta_unique(:,N_det_beta_unique) = string(:,2)
-"""
-
-def write(template_ext,template,imax):
-    print "case(%d)"%(imax)
-    def aux(i2,i1,i,j):
-        if (i==imax-1):
-          print template%locals()
-        else:
-          print template_ext%locals()
-        i += 1
-        j -= 1
-        if (i != imax):
-            i1 = "i%d"%(i)
-            i2 = "i%d"%(i+1)
-            aux(i2,i1,i,j)
-        print "enddo"
-
-    i2 = "i1"
-    i1 = "kept(0)+1"
-    i  = 0
-    aux(i2,i1,i,imax)
-
-def main():
-    print """
-    select case (nelec_kept(1))
-      case(0)
-        continue
-    """
-    for imax in range(1,10):
-        write(template_alpha_ext,template_alpha,imax)
-
-    print """
-    end select
-
-    select case (nelec_kept(2))
-      case(0)
-        continue
-    """
-    for imax in range(1,10):
-        write(template_beta_ext,template_beta,imax)
-    print "end select"
-
-main()
-
-END_SHELL
-
-  TOUCH N_det_alpha_unique N_det_beta_unique psi_det_alpha_unique psi_det_beta_unique
-  call create_wf_of_psi_bilinear_matrix(.False.)
-  call diagonalize_ci
-  j= N_det
-  do i=1,N_det
-    if (psi_average_norm_contrib_sorted(i) < 1.d-6) then
-       j = i-1
-       exit
-    endif
-!  call debug_det(psi_det_sorted(1,1,i),N_int)
-  enddo
-  call save_wavefunction_general(j,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
-
-  deallocate(orb_energy, kept, list, string)
-end

src/Determinants/s2.irp.f

@@ -75,22 +75,6 @@ END_PROVIDER
 
 
 
-subroutine u_0_S2_u_0(e_0,u_0,n,keys_tmp,Nint)
-  use bitmasks
-  implicit none
-  BEGIN_DOC
-  ! Computes e_0 = <u_0|S2|u_0>/<u_0|u_0>
-  !
-  ! n : number of determinants
-  !
-  END_DOC
-  integer, intent(in)            :: n,Nint
-  double precision, intent(out)  :: e_0
-  double precision, intent(in)   :: u_0(n)
-  integer(bit_kind),intent(in)   :: keys_tmp(Nint,2,n)
-  call u_0_S2_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,1,n)
-end
-
 subroutine u_0_S2_u_0_nstates(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
   use bitmasks
   implicit none