Increased task sizes

ocaml/TaskServer.ml

@@ -547,7 +547,6 @@ let terminate program_state rep_socket =
 
   
 let error msg program_state rep_socket =
-    Printf.printf "%s\n%!" msg;
     Message.Error (Message.Error_msg.create msg)
     |> Message.to_string
     |> ZMQ.Socket.send rep_socket ;

plugins/Full_CI_ZMQ/selection_slave.irp.f

@@ -23,31 +23,55 @@ subroutine run_wf
   integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
   integer(ZMQ_PTR) :: zmq_to_qp_run_socket
   double precision :: energy(N_states_diag)
-  character*(64) :: state
+  character*(64) :: states(2)
+  integer :: rc, i
   
   call provide_everything
   
   zmq_context = f77_zmq_ctx_new ()
-  zmq_state = 'selection'
+  states(1) = 'selection'
-  state = 'Waiting'
+  states(2) = 'davidson'
 
   zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
 
   do
-    call wait_for_state(zmq_state,state)
+
-    if(trim(state) /= 'selection') exit
+    call wait_for_states(states,zmq_state,2)
-    print *,  'Getting wave function'
+
-    call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
+    if(trim(zmq_state) == 'Stopped') then
- 
+
+      exit
+
+    else if (trim(zmq_state) == 'selection') then
+
+      ! Selection
+      ! ---------
+
+      print *,  'Selection'
+      call zmq_get_psi(zmq_to_qp_run_socket,1,energy,N_states_diag)
   
-    integer :: rc, i
+      !$OMP PARALLEL PRIVATE(i)
- 
+      i = omp_get_thread_num()
-    print *,  'Selection slave running'
+      call selection_dressing_slave_tcp(i, energy)
- 
+      !$OMP END PARALLEL
-    !$OMP PARALLEL PRIVATE(i)
+      print *,  'Selection done'
-    i = omp_get_thread_num()
+
-    call selection_dressing_slave_tcp(i, energy)
+    else if (trim(zmq_state) == 'davidson') then
-    !$OMP END PARALLEL
+
+      ! Davidson
+      ! --------
+
+      print *,  'Davidson'
+      call davidson_miniserver_get()
+
+      !$OMP PARALLEL PRIVATE(i)
+      i = omp_get_thread_num()
+      call davidson_slave_tcp(i)
+      !$OMP END PARALLEL
+      print *,  'Davidson done'
+
+    endif
+
   end do
 end
 

src/Davidson/davidson.irp.f

@@ -1,3 +0,0 @@
-program davidson
-  stop 1
-end

src/Davidson/davidson_slave.irp.f

@@ -8,7 +8,7 @@ program davidson_slave
   double precision :: energy(N_states_diag)
   character*(64) :: state
   
-!   call provide_everything
+  call provide_everything
   call switch_qp_run_to_master
   
   zmq_context = f77_zmq_ctx_new ()
@@ -35,6 +35,6 @@ program davidson_slave
   end do
 end
 
-! subroutine provide_everything
+subroutine provide_everything
-!   PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context
+  PROVIDE mo_bielec_integrals_in_map psi_det_sorted_bit N_states_diag zmq_context
-! end subroutine
+end subroutine

src/Davidson/diagonalization_hs2.irp.f

@@ -89,7 +89,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
   integer                        :: i,j,k,l,m
   logical                        :: converged
   
-  double precision, allocatable  :: overlap(:,:)
   double precision               :: u_dot_v, u_dot_u
   
   integer, allocatable           :: kl_pairs(:,:)
@@ -144,14 +143,6 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
   integer, external :: align_double
   sze_8 = align_double(sze)
 
-  double precision :: delta
-
-  if (s2_eig) then
-    delta = 1.d0
-  else
-    delta = 0.d0
-  endif
-
   allocate(                                                          &
       kl_pairs(2,N_st_diag*(N_st_diag+1)/2),                         &
       W(sze_8,N_st_diag*davidson_sze_max),                           &
@@ -163,11 +154,20 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
       s_(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max),     &
       s_tmp(N_st_diag*davidson_sze_max,N_st_diag*davidson_sze_max),  &
       residual_norm(N_st_diag),                                      &
-      overlap(N_st_diag,N_st_diag),                                  &
       c(N_st_diag*davidson_sze_max),                                 &
       s2(N_st_diag*davidson_sze_max),                                &
       lambda(N_st_diag*davidson_sze_max))
   
+  h  = 0.d0
+  s_ = 0.d0
+  s_tmp = 0.d0
+  c = 0.d0
+  U = 0.d0
+  S = 0.d0
+  R = 0.d0
+  y = 0.d0
+
+
   ASSERT (N_st > 0)
   ASSERT (N_st_diag >= N_st)
   ASSERT (sze > 0)
@@ -425,7 +425,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
   deallocate (                                                       &
       kl_pairs,                                                      &
       W, residual_norm,                                              &
-      U, overlap,                                                    &
+      U,                                                             &
       R, c, S,                                                       &
       h,                                                             &
       y, s_, s_tmp,                                                  &

src/Davidson/u0Hu0.irp.f

@@ -249,7 +249,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
   call davidson_init(handler)
   do sh=shortcut(0,1),1,-1
     workload += (shortcut(sh+1,1) - shortcut(sh,1))**2
-    if(workload > 10000) then
+    if(workload > 1000000) then
       blocke = sh
       call davidson_add_task(handler, blocke, blockb)
       blockb = sh-1
@@ -257,7 +257,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
     end if
   enddo
   
-  if(blockb) call davidson_add_task(handler, 1, blockb)
+  if(blockb > 0) call davidson_add_task(handler, 1, blockb)
 
   call davidson_run(handler, v_0, s_0)
   

src/ZMQ/utils.irp.f

@@ -881,3 +881,37 @@ end
 
 
 
+subroutine wait_for_states(state_wait,state,n)
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Wait for the ZMQ state to be ready
+  END_DOC
+  integer, intent(in)            :: n
+  character*(64), intent(in)     :: state_wait(n)
+  character*(64), intent(out)    :: state
+  integer(ZMQ_PTR)               :: zmq_socket_sub
+  integer(ZMQ_PTR), external     :: new_zmq_sub_socket
+  integer                        :: rc, i
+  logical                        :: condition
+
+  zmq_socket_sub       = new_zmq_sub_socket()
+  state = 'Waiting'
+  condition = .True.
+  do while (condition)
+    rc = f77_zmq_recv( zmq_socket_sub, state, 64, 0)
+    if (rc > 0) then
+      state = trim(state(1:rc))
+    else
+      print *,  'Timeout reached. Stopping'
+      state = "Stopped"
+    endif
+    condition = trim(state) /= 'Stopped'
+    do i=1,n
+      condition = condition .and. (trim(state) /= trim(state_wait(i)))
+    enddo
+  end do
+  call end_zmq_sub_socket(zmq_socket_sub)
+end
+
+