Retry with zmq_abort

plugins/Full_CI_ZMQ/selection_davidson_slave.irp.f

@@ -133,7 +133,7 @@ subroutine run_wf
 
       call wall_time(t0)
       if (zmq_get_N_states_diag(zmq_to_qp_run_socket,1) == -1) cycle
-      if (zmq_get_psi_bilinear(zmq_to_qp_run_socket,1) == -1) cycle
+      if (zmq_get_psi(zmq_to_qp_run_socket,1) == -1) cycle
       if (zmq_get_dvector(zmq_to_qp_run_socket,1,'energy',energy,N_states_diag) == -1) cycle
 
       call wall_time(t1)

src/Davidson/davidson_parallel.irp.f

@@ -309,7 +309,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   if (zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) == -1) then
     stop 'Unable to put N_states_diag on ZMQ server'
   endif
-  if (zmq_put_psi_bilinear(zmq_to_qp_run_socket,1) == -1) then
+  if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
     stop 'Unable to put psi on ZMQ server'
   endif
   energy = 0.d0
@@ -323,7 +323,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
 
   integer :: istep, imin, imax, ishift, ipos
   integer, external :: add_task_to_taskserver
-  integer, parameter :: tasksize=20000
+  integer, parameter :: tasksize=40000
   character*(100000) :: task
   istep=1
   ishift=0
@@ -372,7 +372,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   integer*8 :: rc8
   double precision :: energy(N_st)
 
-  integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag, zmq_put_psi_bilinear
+  integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag
   integer, external :: zmq_put_dmatrix
 
   if (size(u_t) < 8388608) then
@@ -409,11 +409,22 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
   !$OMP END PARALLEL
   call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'davidson')
 
+  !$OMP PARALLEL
+  !$OMP SINGLE
   do k=1,N_st
+    !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
     call dset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
+    !$OMP END TASK
+    !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
     call dset_order(s_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
+    !$OMP END TASK
+    !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
     call dset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
+    !$OMP END TASK
   enddo
+  !$OMP END SINGLE
+  !$OMP TASKWAIT
+  !$OMP END PARALLEL
 end
 
 

src/Davidson/u0Hu0.irp.f

@@ -491,6 +491,7 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
     deallocate(u_1)
   endif
   double precision :: norm
+  !$OMP PARALLEL DO PRIVATE(i,norm) DEFAULT(SHARED)
   do i=1,N_st
     norm = u_dot_u(u_0(1,i),n)
     if (norm /= 0.d0) then
@@ -499,6 +500,7 @@ subroutine u_0_H_u_0(e_0,u_0,n,keys_tmp,Nint,N_st,sze)
       e_0(i) = 0.d0
     endif
   enddo
+  !$OMP END PARALLEL DO
   deallocate (s_0, v_0)
 end
 

src/Determinants/determinants.irp.f

@@ -336,10 +336,9 @@ end subroutine
    ! function.
    END_DOC
    
-print *,  '==>  ', irp_here
    call sort_dets_by_det_search_key(N_det, psi_det, psi_coef,        &
        psi_det_sorted_bit, psi_coef_sorted_bit, N_states)
-print *,  ' <== ', irp_here
+
 END_PROVIDER
  
 subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, det_out, coef_out, N_st)

src/Determinants/spindeterminants.irp.f

@@ -80,11 +80,7 @@ BEGIN_TEMPLATE
  !$OMP END PARALLEL DO
 
 
-double precision :: w0,w1
-call wall_time(w0)
  call i8sort(bit_tmp,iorder,N_det)
-call wall_time(w1)
-print *,  '==>  ', irp_here, w1-w0
 
  N_det_$alpha_unique = 0
  last_key = 0_8

src/ZMQ/utils.irp.f

@@ -783,21 +783,31 @@ integer function zmq_abort(zmq_to_qp_run_socket)
   ! Aborts a running parallel computation
   END_DOC
   integer(ZMQ_PTR), intent(in)   :: zmq_to_qp_run_socket
-  integer                        :: rc, sze
+  integer                        :: rc, sze, i
+  integer, parameter             :: count_max=60
   character*(512)                :: message
   zmq_abort = 0
 
   write(message,*) 'abort '
   
+
   sze = len(trim(message))
-  rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
+  do i=1,count_max
+    rc = f77_zmq_send(zmq_to_qp_run_socket, trim(message), sze, 0)
+    if (rc == sze) exit
+    call sleep(1)
+  enddo
   if (rc /= sze) then
     print *,  'zmq_abort: rc /= sze', rc, sze
     zmq_abort = -1
     return
   endif
   
-  rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
+  do i=1,count_max
+    rc = f77_zmq_recv(zmq_to_qp_run_socket, message, 510, 0)
+    if (trim(message(1:rc)) == 'ok') exit
+    call sleep(1)
+  enddo
   if (trim(message(1:rc)) /= 'ok') then
     print *,  'zmq_abort: ', rc, ':', trim(message(1:rc))
     zmq_abort = -1