Fixed shiftedBk

plugins/DavidsonDressed/diagonalize_CI.irp.f

@@ -63,9 +63,6 @@ END_PROVIDER
     call davidson_diag_HS2(psi_det,CI_eigenvectors_dressed, CI_eigenvectors_s2_dressed,&
         size(CI_eigenvectors_dressed,1), CI_electronic_energy_dressed,&
         N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,1)
-!    call u_0_S2_u_0(CI_eigenvectors_s2_dressed,CI_eigenvectors_dressed,N_det,psi_det,N_int,&
-!        N_states_diag,size(CI_eigenvectors_dressed,1))
-    
     
   else if (diag_algorithm == "Lapack") then
     
@@ -159,6 +156,7 @@ subroutine diagonalize_CI_dressed
 !  eigenstates of the CI matrix
   END_DOC
   integer :: i,j
+  PROVIDE delta_ij
   do j=1,N_states
     do i=1,N_det
       psi_coef(i,j) = CI_eigenvectors_dressed(i,j)

plugins/dress_zmq/alpha_factory.irp.f

@@ -81,10 +81,6 @@ subroutine generate_singles_and_doubles(delta_ij_loc, i_generator, bitmask_index
     hole    (k,2) = iand(psi_det_generators(k,2,i_generator), generators_bitmask(k,2,s_hole,bitmask_index))
     particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), generators_bitmask(k,1,s_part,bitmask_index))
     particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), generators_bitmask(k,2,s_part,bitmask_index))
-    !hole    (k,1) = iand(psi_det_generators(k,1,i_generator), full_ijkl_bitmask(k))
-    !hole    (k,2) = iand(psi_det_generators(k,2,i_generator), full_ijkl_bitmask(k))
-    !particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), full_ijkl_bitmask(k))
-    !particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), full_ijkl_bitmask(k)) 
   enddo
 
   integer                        :: N_holes(2), N_particles(2)

plugins/dress_zmq/dress_stoch_routines.irp.f

@@ -284,7 +284,7 @@ subroutine ZMQ_dress(E, dress, delta_out, delta_s2_out, relative_error)
     if (zmq_put_dvector(zmq_to_qp_run_socket,1,"state_average_weight",state_average_weight,N_states) == -1) then
       stop 'Unable to put state_average_weight on ZMQ server'
     endif
-    if (zmq_put_int(zmq_to_qp_run_socket,1,"dress_stoch_istate",dress_stoch_istate) == -1) then
+    if (zmq_put_int(zmq_to_qp_run_socket,1,'dress_stoch_istate',dress_stoch_istate) == -1) then
       stop 'Unable to put dress_stoch_istate on ZMQ server'
     endif
       if (zmq_put_dvector(zmq_to_qp_run_socket,1,'threshold_selectors',threshold_selectors,1) == -1) then
@@ -483,9 +483,9 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
   integer, external :: zmq_delete_tasks, dress_find_sample
   logical :: found
   integer :: worker_id
+  worker_id=1
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
 
-  call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,1)
   
   found = .false.
   delta = 0d0
@@ -542,7 +542,7 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
       if(dabs(error / avg) <= relative_error) then
         integer, external :: zmq_put_dvector
         integer, external :: zmq_put_int
-        i= zmq_put_int(zmq_to_qp_run_socket, worker_id, "ending", (m-1))
+        i= zmq_put_int(zmq_to_qp_run_socket, worker_id, 'ending', (m-1))
         found = .true.
       end if
     else
@@ -607,7 +607,6 @@ subroutine dress_collector(zmq_socket_pull, E, relative_error, delta, delta_s2,
   !end do
   !print *, "SUM", E(1)+sum(edi(:))
   !print *, "DOT", E(1)+tmp
-  call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id)
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
 end subroutine
 

plugins/dress_zmq/run_dress_slave.irp.f

@@ -62,6 +62,7 @@ subroutine run_dress_slave(thread,iproce,energy)
   cp_done = 0
   cp_sent = 0
   will_send = 0
+  cp_max(:) = 0
 
   double precision :: hij, sij, tmp
   purge_task_id = 0
@@ -76,7 +77,11 @@ subroutine run_dress_slave(thread,iproce,energy)
   !$OMP PRIVATE(task_buf, ntask_buf,time, time0)
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
   zmq_socket_push      = new_zmq_push_socket(thread)
-  call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread)
+  integer, external :: connect_to_taskserver
+  if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
+    print *,  irp_here, ': Unable to connect to task server'
+    stop -1
+  endif
   if(worker_id == -1) then
     call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
     call end_zmq_push_socket(zmq_socket_push,thread)
@@ -91,8 +96,8 @@ subroutine run_dress_slave(thread,iproce,energy)
     call push_dress_results(zmq_socket_push, 0, 0, edI_task, edI_index, breve_delta_m, task_buf, ntask_buf)
   end if
 
-  cp_max(:) = 0
-  do while(cp_done > cp_sent .or. m /= dress_N_cp+1)
+  !$OMP FLUSH
+  do while( (cp_done > cp_sent) .or. (m /= dress_N_cp+1) )
     !$OMP CRITICAL (send)
     if(ntask_tbd == 0) then
       ntask_tbd = size(task_tbd)
@@ -233,7 +238,12 @@ subroutine run_dress_slave(thread,iproce,energy)
     end if
    
   !$OMP END SINGLE
-  call disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id)
+
+  integer, external :: disconnect_from_taskserver
+  if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
+    print *,  irp_here, ': Unable to disconnect from task server'
+    stop -1
+  endif
   call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
   call end_zmq_push_socket(zmq_socket_push,thread)
   !$OMP END PARALLEL

plugins/shiftedbk/selection_types.f90

@@ -1,9 +0,0 @@
-module selection_types
-  type selection_buffer
-    integer :: N, cur
-    integer(8)      , pointer :: det(:,:,:)
-    double precision, pointer :: val(:)
-    double precision          :: mini
-  endtype
-end module
-

src/Determinants/determinants.irp.f

@@ -536,7 +536,7 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
     call ezfio_set_determinants_mo_label(mo_label)
     
     allocate (psi_det_save(N_int,2,ndet))
-    !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k) SHARED(psi_det_save,psidet,ndet,N_int)
+    !$OMP PARALLEL DO DEFAULT(NONE) PRIVATE(i,j,k) SHARED(psi_det_save,psidet,ndet,N_int,accu_norm)
     do i=1,ndet
       do j=1,2
         do k=1,N_int

src/Determinants/occ_pattern.irp.f

@@ -62,17 +62,6 @@ subroutine occ_pattern_to_dets(o,d,sze,n_alpha,Nint)
   enddo
 
   call bitstring_to_list(o(1,1), list_todo, nt, Nint)
-!  nt = 0
-!  ishift = 2
-!  do i=1,Nint
-!    l = o(i,1)
-!    do while (l /= 0_bit_kind)
-!      nt = nt+1
-!      list_todo(nt) = ishift+popcnt(l-1_bit_kind) - popcnt(l)
-!      l = iand(l,l-1_bit_kind)
-!    enddo
-!    ishift = ishift + bit_kind_size
-!  enddo
 
   na = 0
   nd = 0