Almost working but still broken

plugins/dress_zmq/alpha_factory.irp.f

@@ -637,7 +637,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, indexes, ab
   integer(bit_kind),intent(in)   :: mask(N_int, 2), det(N_int, 2, N_sel)
   logical, intent(inout)         :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2)
   integer, intent(inout)         :: indexes(0:mo_tot_num, 0:mo_tot_num)
-  integer, intent(inout) :: abuf(0:*)
+  integer, intent(inout)         :: abuf(*)
   integer                        :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt, s
   integer(bit_kind)              :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
   integer :: phasemask(2,N_int*bit_kind_size)

plugins/dress_zmq/dress_general.irp.f

@@ -29,8 +29,6 @@ subroutine run_dressing(N_st,energy)
     delta_E = 1.d0
     iteration = 0
     do iteration=1,n_it_dress_max
-      N_det_delta_ij = N_det
-      touch N_det_delta_ij
       print *,  '===============================================' 
       print *,  'Iteration', iteration, '/', n_it_dress_max
       print *,  '===============================================' 
@@ -40,9 +38,6 @@ subroutine run_dressing(N_st,energy)
       do i=1,N_st
         print *,  i, psi_energy(i)+nuclear_repulsion
       enddo
-      !print *, "DELTA IJ", delta_ij(1,1,1)
-      PROVIDE delta_ij_tmp
-      if(.true.) call delta_ij_done()
       print *,  'Dressed energy <Psi|H+Delta|Psi>'
       do i=1,N_st
         print *,  i, ci_energy_dressed(i)
@@ -56,7 +51,6 @@ subroutine run_dressing(N_st,energy)
       call write_double(6,delta_E,"delta_E (undressed)")
       delta_E = dabs(delta_E)
       call save_wavefunction
-!     call ezfio_set_dress_zmq_energy(ci_energy_dressed(1))
       if (delta_E < thresh_dress) then
         exit
       endif

plugins/dress_zmq/dress_stoch_routines.irp.f

@@ -276,7 +276,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
     
     call omp_set_nested(.true.)
 
-if (.false.) then !! TODO
+if (.true.) then !! TODO
     !$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2)              &
         !$OMP  PRIVATE(i)
     i = omp_get_thread_num()
@@ -462,11 +462,16 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
       end do
       t = dress_dot_t(m)
       avg = S(t) / dble(c)
-      eqt = (S2(t) / c) - (S(t)/c)**2
+      if (c > 1) then
-      eqt = sqrt(eqt / dble(c-1))
+        eqt = (S2(t) / c) - (S(t)/c)**2
-      error = eqt
+        eqt = sqrt(eqt / dble(c-1))
-      time = omp_get_wtime()
+        error = eqt
-      print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0+E(dress_stoch_istate), eqt, time-time0, ''
+        time = omp_get_wtime()
+        print '(G10.3, 2X, F16.10, 2X, G16.3, 2X, F16.4, A20)', c, avg+E0+E(dress_stoch_istate), eqt, time-time0, ''
+      else
+        eqt = 1.d0
+        error = eqt
+      endif
       m += 1
       if(eqt <= relative_error) then
         integer, external :: zmq_put_dvector

plugins/dress_zmq/dressing.irp.f

@@ -65,7 +65,7 @@ END_PROVIDER
 
 BEGIN_PROVIDER [ integer , N_det_delta_ij ]
   implicit none
-  N_det_delta_ij = 1
+  N_det_delta_ij = N_det
 END_PROVIDER
 
 BEGIN_PROVIDER [ double precision, delta_ij, (N_states, N_det, 2) ]

plugins/dress_zmq/run_dress_slave.irp.f

@@ -41,7 +41,7 @@ subroutine run_dress_slave(thread,iproce,energy)
 ! double precision, external :: omp_get_wtime
 double precision :: time, time0
   integer :: ntask_tbd, task_tbd(Nproc), i_gen_tbd(Nproc), subset_tbd(Nproc)
-  if(iproce /= 0) stop "RUN DRESS SLAVE is OMP"
+!  if(iproce /= 0) stop "RUN DRESS SLAVE is OMP"
   
   allocate(delta_det(N_states, N_det, 0:pt2_N_teeth+1, 2))
   allocate(cp(N_states, N_det, dress_N_cp, 2))

src/Davidson/u0Hu0.irp.f

@@ -28,6 +28,7 @@ subroutine H_S2_u_0_nstates_openmp(v_0,s_0,u_0,N_st,sze)
   double precision, allocatable  :: u_t(:,:), v_t(:,:), s_t(:,:)
   !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t
   allocate(u_t(N_st,N_det),v_t(N_st,N_det),s_t(N_st,N_det))
+
   do k=1,N_st
     call dset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
   enddo